From c1db8290de1886d182a0a1abd9c93fdeefed7fd9 Mon Sep 17 00:00:00 2001 From: Andres Sepulveda Date: Wed, 28 Feb 2024 10:25:17 -0300 Subject: [PATCH 1/4] Update README.md Added Wang et al., 2023 --- README.md | 1 + 1 file changed, 1 insertion(+) diff --git a/README.md b/README.md index acc6fc22..6efc0625 100644 --- a/README.md +++ b/README.md @@ -372,6 +372,7 @@ To run this test case, set the right path in the *build_roms.bash* file and comp Ungarish, M. (2010). An Introduction to Gravity Currents and Intrusions Introduction. Introduction to Gravity Currents and Intrusions, 1-10. +[Wang, C., Chant, R. J., & Jackson, R. H. (2023). Parameterizing Subglacial Discharge in Modeling Buoyancy Driven Flow in Tidewater Glacier Fjords. Journal of Geophysical Research: Oceans, 128(8), e2023JC019924.](https://agupubs.onlinelibrary.wiley.com/doi/full/10.1029/2023JC019924) --- ## Contact Info From d1bec9f51d64cda672aa0326d6a6e818bded008f Mon Sep 17 00:00:00 2001 From: Andres Sepulveda Date: Fri, 1 Mar 2024 03:27:56 -0300 Subject: [PATCH 2/4] Add CROCO code Add CROCO v1p3p1 code --- CROCO/croco-v1.3.1/.gitattributes | 1 + CROCO/croco-v1.3.1/.gitignore | 18 + CROCO/croco-v1.3.1/.gitlab-ci.yml | 120 + .../AGRIF/AGRIF_FILES/modarrays.F90 | 842 + .../croco-v1.3.1/AGRIF/AGRIF_FILES/modbc.F90 | 649 + .../AGRIF/AGRIF_FILES/modbcfunction.F90 | 722 + .../AGRIF/AGRIF_FILES/modcluster.F90 | 1277 ++ .../AGRIF/AGRIF_FILES/modcurgridfunctions.F90 | 1019 ++ .../AGRIF/AGRIF_FILES/modgrids.F90 | 478 + .../AGRIF/AGRIF_FILES/modinit.F90 | 209 + .../AGRIF/AGRIF_FILES/modinitvars.F90 | 86 + .../AGRIF/AGRIF_FILES/modinterp.F90 | 1534 ++ .../AGRIF/AGRIF_FILES/modinterpbasic.F90 | 1464 ++ .../AGRIF/AGRIF_FILES/modlinktomodel.F90 | 173 + .../AGRIF/AGRIF_FILES/modmask.F90 | 586 + .../croco-v1.3.1/AGRIF/AGRIF_FILES/modmpp.F90 | 636 + .../AGRIF/AGRIF_FILES/modprocs.F90 | 208 + .../AGRIF/AGRIF_FILES/modsauv.F90 | 663 + .../croco-v1.3.1/AGRIF/AGRIF_FILES/modseq.F90 | 640 + .../AGRIF/AGRIF_FILES/modtypes.F90 | 452 + .../AGRIF/AGRIF_FILES/modupdate.F90 | 2132 +++ .../AGRIF/AGRIF_FILES/modupdatebasic.F90 | 434 + .../AGRIF/AGRIF_FILES/modutil.F90 | 1150 ++ .../AGRIF/AGRIF_FILES/modvariables.F90 | 146 + CROCO/croco-v1.3.1/AGRIF/LIB/DiversListe.c | 551 + CROCO/croco-v1.3.1/AGRIF/LIB/Makefile | 68 + .../croco-v1.3.1/AGRIF/LIB/SubLoopCreation.c | 449 + CROCO/croco-v1.3.1/AGRIF/LIB/UtilAgrif.c | 838 + CROCO/croco-v1.3.1/AGRIF/LIB/UtilCharacter.c | 387 + CROCO/croco-v1.3.1/AGRIF/LIB/UtilFile.c | 128 + CROCO/croco-v1.3.1/AGRIF/LIB/UtilFortran.c | 675 + CROCO/croco-v1.3.1/AGRIF/LIB/UtilListe.c | 823 + CROCO/croco-v1.3.1/AGRIF/LIB/UtilNotGridDep.c | 107 + .../AGRIF/LIB/WorkWithAllocatelist.c | 122 + .../AGRIF/LIB/WorkWithParameterlist.c | 101 + .../AGRIF/LIB/WorkWithglobliste.c | 107 + .../AGRIF/LIB/WorkWithlistdatavariable.c | 216 + .../AGRIF/LIB/WorkWithlistmoduleinfile.c | 160 + .../AGRIF/LIB/WorkWithlistofcoupled.c | 105 + .../LIB/WorkWithlistofmodulebysubroutine.c | 303 + .../AGRIF/LIB/WorkWithlistvarindoloop.c | 1928 +++ .../AGRIF/LIB/WorkWithvarofsubroutineliste.c | 78 + CROCO/croco-v1.3.1/AGRIF/LIB/WriteInFile.c | 159 + .../AGRIF/LIB/Writedeclarations.c | 746 + CROCO/croco-v1.3.1/AGRIF/LIB/decl.h | 687 + CROCO/croco-v1.3.1/AGRIF/LIB/dependfile.c | 974 ++ CROCO/croco-v1.3.1/AGRIF/LIB/fortran.c | 13086 ++++++++++++++++ CROCO/croco-v1.3.1/AGRIF/LIB/main.c | 3959 +++++ CROCO/croco-v1.3.1/AGRIF/LIB/run | 2 + CROCO/croco-v1.3.1/AGRIF/LIB/toamr.c | 1169 ++ CROCO/croco-v1.3.1/AGRIF/Makefile | 133 + CROCO/croco-v1.3.1/AGRIF/agrif2model.F90 | 89 + CROCO/croco-v1.3.1/AGRIF/doc/Doxyfile | 2381 +++ CROCO/croco-v1.3.1/AGRIF/doc/calltree_f90.py | 554 + CROCO/croco-v1.3.1/CHANGELOG.md | 35 + .../croco-v1.3.1/CVTK/common/CONFIGURE_GLOBAL | 63 + .../CVTK/common/CONFIGURE_GLOBAL_PERFRST | 57 + .../AGRIF_FixedGrids.in.VORTEX | 7 + .../common/TEST_CASES_CVTK/VHR/README.txt | 3 + .../CVTK/common/TEST_CASES_CVTK/barocjet.m | 119 + .../CVTK/common/TEST_CASES_CVTK/barocvortex.m | 107 + .../common/TEST_CASES_CVTK/floats.in.River | 10 + .../CVTK/common/TEST_CASES_CVTK/igw_frc.nc | Bin 0 -> 3580284 bytes .../CVTK/common/TEST_CASES_CVTK/igw_grd.nc | Bin 0 -> 954624 bytes .../common/TEST_CASES_CVTK/make_clim_IGW.m | 132 + .../common/TEST_CASES_CVTK/make_grid_IGW.m | 218 + .../CVTK/common/TEST_CASES_CVTK/make_jet.m | 444 + .../CVTK/common/TEST_CASES_CVTK/make_rip.m | 320 + .../common/TEST_CASES_CVTK/make_tides_IGW.m | 149 + .../CVTK/common/TEST_CASES_CVTK/make_vortex.m | 371 + .../common/TEST_CASES_CVTK/sediment_flume.in | 90 + .../TEST_CASES_CVTK/shoreface_JW_frc.nc | Bin 0 -> 18800 bytes .../CVTK/common/TEST_CASES_CVTK/vortex_clm.nc | Bin 0 -> 2691240 bytes .../common/TEST_CASES_CVTK/vortex_clm.nc.1 | Bin 0 -> 2436744 bytes .../CVTK/common/TEST_CASES_CVTK/vortex_grd.nc | Bin 0 -> 215888 bytes .../common/TEST_CASES_CVTK/vortex_grd.nc.1 | Bin 0 -> 195776 bytes .../CVTK/common/TEST_CASES_CVTK/vortex_his.nc | Bin 0 -> 1085244 bytes .../common/TEST_CASES_CVTK/vortex_his.nc.1 | Bin 0 -> 983844 bytes .../CVTK/common/TEST_CASES_CVTK/vortex_ini.nc | Bin 0 -> 1314592 bytes .../common/TEST_CASES_CVTK/vortex_ini.nc.1 | Bin 0 -> 1190248 bytes .../croco-v1.3.1/CVTK/common/cleanup_all.bash | 23 + .../croco-v1.3.1/CVTK/common/git_process.bash | 9 + CROCO/croco-v1.3.1/CVTK/common/gitinfo.sh | 46 + .../CVTK/common/jobcomp_rvtk.bash | 343 + .../croco-v1.3.1/CVTK/common/mk_CHECKALL.bash | 9 + .../croco-v1.3.1/CVTK/common/mk_CLEANALL.bash | 7 + .../CVTK/common/print/fancy_almost.txt | 6 + .../CVTK/common/print/fancy_critical.txt | 6 + .../CVTK/common/print/fancy_failure.txt | 6 + .../CVTK/common/print/fancy_sucess.txt | 6 + .../CVTK/test_perfrst/CONFIGURE_REG_PERFRST | 8 + .../Configure_Test_reg_ALL_perfrst/AGRIF1W | 16 + .../Configure_Test_reg_ALL_perfrst/AGRIF2W | 16 + .../Configure_Test_reg_ALL_perfrst/BRY | 16 + .../BSTRESS_FAST | 16 + .../Configure_Test_reg_ALL_perfrst/BULK | 16 + .../Configure_Test_reg_ALL_perfrst/CFB | 16 + .../Configure_Test_reg_ALL_perfrst/CFBBULK | 16 + .../CFBBULKONLINE | 16 + .../Configure_Test_reg_ALL_perfrst/CLIM | 16 + .../Configure_Test_reg_ALL_perfrst/GLS | 16 + .../Configure_Test_reg_ALL_perfrst/PISCES | 16 + .../Configure_Test_reg_ALL_perfrst/TIDES | 17 + .../Configure_Test_reg_perfrst/BRY | 16 + .../Configure_Test_reg_perfrst/BSTRESS_FAST | 16 + .../Configure_Test_reg_perfrst/BULK | 16 + .../Configure_Test_reg_perfrst/CFB | 16 + .../Configure_Test_reg_perfrst/CFBBULK | 16 + .../Configure_Test_reg_perfrst/CFBBULKONLINE | 16 + .../Configure_Test_reg_perfrst/CLIM | 16 + .../Configure_Test_reg_perfrst/GLS | 16 + .../Configure_Test_reg_perfrst/TIDES | 17 + .../create_link_for_Test_reg_perfrst.sh | 35 + .../create_link_master_reg_perfrst.sh | 174 + .../test_perfrst/comp_run_mpi_perfrst.bash | 93 + .../extract_results_croco_perfrst.bash | 80 + .../test_perfrst/gather_recap_perfrst.bash | 35 + .../CVTK/test_perfrst/mk_TESTALL_perfrst.bash | 104 + .../CVTK/test_perfrst/mk_TestDIR_perfrst.bash | 47 + .../test_perfrst/rvtk_fast_qsub_perfrst.bash | 171 + .../CVTK/test_perfrst/test_croco_perfrst.sh | 36 + CROCO/croco-v1.3.1/CVTK/test_real/README.txt | 53 + CROCO/croco-v1.3.1/CVTK/test_real/clean.sh | 7 + .../croco-v1.3.1/CVTK/test_real/diff_real.sh | 18 + .../croco-v1.3.1/CVTK/test_real/plot_real.sh | 98 + CROCO/croco-v1.3.1/CVTK/test_real/run_real.sh | 174 + .../croco-v1.3.1/CVTK/test_real/send_real.sh | 23 + .../croco-v1.3.1/CVTK/test_real/test_real.sh | 94 + .../CVTK/test_repro/CONFIGURE_ANA | 8 + .../CVTK/test_repro/CONFIGURE_REG | 8 + .../CVTK/test_repro/CONFIGURE_VORT | 8 + .../Scripts_ana/Configure_Test_ana/BASIN | 15 + .../Scripts_ana/Configure_Test_ana/CANYON | 15 + .../Scripts_ana/Configure_Test_ana/DUNE | 15 + .../Scripts_ana/Configure_Test_ana/EQUATOR | 15 + .../Scripts_ana/Configure_Test_ana/ESTUARY | 15 + .../Scripts_ana/Configure_Test_ana/GRAV_ADJ | 15 + .../Scripts_ana/Configure_Test_ana/IGW | 15 + .../Scripts_ana/Configure_Test_ana/INNERSHELF | 15 + .../Scripts_ana/Configure_Test_ana/INTERNAL | 15 + .../Scripts_ana/Configure_Test_ana/ISOLITON | 15 + .../Scripts_ana/Configure_Test_ana/JET | 15 + .../Scripts_ana/Configure_Test_ana/KH_INST | 15 + .../Scripts_ana/Configure_Test_ana/OVERFLOW | 15 + .../Scripts_ana/Configure_Test_ana/RIP | 15 + .../Scripts_ana/Configure_Test_ana/RIVER | 15 + .../Scripts_ana/Configure_Test_ana/SANDBAR | 15 + .../Scripts_ana/Configure_Test_ana/SEAMOUNT | 15 + .../Scripts_ana/Configure_Test_ana/SHELFRONT | 15 + .../Scripts_ana/Configure_Test_ana/SHOREFACE | 15 + .../Scripts_ana/Configure_Test_ana/SWASH | 15 + .../Scripts_ana/Configure_Test_ana/TANK | 15 + .../Scripts_ana/Configure_Test_ana/THACKER | 15 + .../Scripts_ana/Configure_Test_ana/TIDAL_FLAT | 15 + .../Configure_Test_ana/TS_HADV_TEST | 15 + .../Scripts_ana/Configure_Test_ana/UPWELLING | 15 + .../Scripts_ana/Configure_Test_ana_ALL/BASIN | 15 + .../Scripts_ana/Configure_Test_ana_ALL/CANYON | 15 + .../Scripts_ana/Configure_Test_ana_ALL/DUNE | 15 + .../Configure_Test_ana_ALL/EQUATOR | 15 + .../Configure_Test_ana_ALL/GRAV_ADJ | 15 + .../Scripts_ana/Configure_Test_ana_ALL/IGW | 15 + .../Configure_Test_ana_ALL/INNERSHELF | 15 + .../Configure_Test_ana_ALL/INTERNAL | 15 + .../Configure_Test_ana_ALL/ISOLITON | 15 + .../Scripts_ana/Configure_Test_ana_ALL/JET | 15 + .../Configure_Test_ana_ALL/KH_INST | 15 + .../Configure_Test_ana_ALL/OVERFLOW | 15 + .../Scripts_ana/Configure_Test_ana_ALL/RIP | 15 + .../Scripts_ana/Configure_Test_ana_ALL/RIVER | 15 + .../Configure_Test_ana_ALL/SANDBAR | 15 + .../Configure_Test_ana_ALL/SEAMOUNT | 15 + .../Configure_Test_ana_ALL/SHELFRONT | 15 + .../Configure_Test_ana_ALL/SHOREFACE | 15 + .../Scripts_ana/Configure_Test_ana_ALL/SWASH | 15 + .../Scripts_ana/Configure_Test_ana_ALL/TANK | 15 + .../Configure_Test_ana_ALL/THACKER | 15 + .../Configure_Test_ana_ALL/TIDAL_FLAT | 15 + .../Configure_Test_ana_ALL/TS_HADV_TEST | 15 + .../Configure_Test_ana_ALL/UPWELLING | 15 + .../Scripts_ana/create_link_for_Test_ana.sh | 27 + .../Scripts_ana/create_link_master_ana.sh | 86 + .../Scripts_reg/Configure_Test_reg/AGRIF1W22 | 15 + .../Scripts_reg/Configure_Test_reg/AGRIF2W22 | 15 + .../Scripts_reg/Configure_Test_reg/BRY14 | 15 + .../Scripts_reg/Configure_Test_reg/BRY22 | 15 + .../Scripts_reg/Configure_Test_reg/BRY41 | 15 + .../Configure_Test_reg/BRYPISCES22 | 15 + .../Configure_Test_reg/BSTRESS_FASTGLS22 | 15 + .../Configure_Test_reg/BSTRESS_FASTKPP22 | 15 + .../Scripts_reg/Configure_Test_reg/BULK22 | 15 + .../Configure_Test_reg/BULKONLINE22 | 15 + .../Scripts_reg/Configure_Test_reg/CFB22 | 15 + .../Scripts_reg/Configure_Test_reg/CFBBULK22 | 15 + .../Configure_Test_reg/CFBBULKONLINE22 | 15 + .../Scripts_reg/Configure_Test_reg/CLIM14 | 15 + .../Scripts_reg/Configure_Test_reg/CLIM22 | 15 + .../Scripts_reg/Configure_Test_reg/CLIM41 | 15 + .../Scripts_reg/Configure_Test_reg/GLS22 | 15 + .../Scripts_reg/Configure_Test_reg/TIDES22 | 16 + .../Configure_Test_reg_ALL/AGRIF1W22 | 15 + .../Configure_Test_reg_ALL/AGRIF2W22 | 15 + .../Scripts_reg/Configure_Test_reg_ALL/BRY14 | 15 + .../Scripts_reg/Configure_Test_reg_ALL/BRY22 | 15 + .../Scripts_reg/Configure_Test_reg_ALL/BRY41 | 15 + .../Configure_Test_reg_ALL/BRYPISCES22 | 15 + .../Configure_Test_reg_ALL/BRYPISCESAGRIF22 | 15 + .../Configure_Test_reg_ALL/BSTRESS_FASTGLS22 | 15 + .../Configure_Test_reg_ALL/BSTRESS_FASTKPP22 | 15 + .../Scripts_reg/Configure_Test_reg_ALL/BULK22 | 15 + .../Configure_Test_reg_ALL/BULKONLINE22 | 15 + .../Scripts_reg/Configure_Test_reg_ALL/CFB22 | 15 + .../Configure_Test_reg_ALL/CFBBULK22 | 15 + .../Configure_Test_reg_ALL/CFBBULKONLINE22 | 15 + .../Scripts_reg/Configure_Test_reg_ALL/CLIM14 | 15 + .../Scripts_reg/Configure_Test_reg_ALL/CLIM22 | 15 + .../Scripts_reg/Configure_Test_reg_ALL/CLIM41 | 15 + .../Scripts_reg/Configure_Test_reg_ALL/GLS22 | 15 + .../Configure_Test_reg_ALL/TIDES22 | 16 + .../Scripts_reg/create_link_for_Test_reg.sh | 33 + .../Scripts_reg/create_link_master_reg.sh | 85 + .../Scripts_vort/Configure_Test_vort/AGRIF1W | 16 + .../Scripts_vort/Configure_Test_vort/AGRIF2W | 16 + .../Scripts_vort/Configure_Test_vort/NoAGRIF | 15 + .../Scripts_vort/create_link_for_Test_vort.sh | 31 + .../Scripts_vort/create_link_master_vort.sh | 68 + .../CVTK/test_repro/comp_run_mpi.bash | 61 + .../CVTK/test_repro/comp_run_openmp.bash | 58 + .../CVTK/test_repro/comp_run_serial.bash | 40 + .../doc/Doc_CVTK_FAST_v1.1_datarmor.pdf | Bin 0 -> 135470 bytes .../test_repro/extract_results_croco.bash | 133 + .../CVTK/test_repro/gather_recap.bash | 37 + .../CVTK/test_repro/mk_TESTALL.bash | 133 + .../CVTK/test_repro/mk_TestDIR.bash | 48 + .../CVTK/test_repro/rvtk_fast_qsub.bash | 319 + .../CVTK/test_repro/test_croco.sh | 36 + CROCO/croco-v1.3.1/DOC_SPHINX/template_doc | 0 CROCO/croco-v1.3.1/MPI_NOLAND/Makefile | 19 + CROCO/croco-v1.3.1/MPI_NOLAND/README.txt | 54 + CROCO/croco-v1.3.1/MPI_NOLAND/mpp_optimiz.f90 | 510 + CROCO/croco-v1.3.1/MPI_NOLAND/mpp_plot.py | 153 + CROCO/croco-v1.3.1/MPI_NOLAND/namelist | 51 + .../croco-v1.3.1/MUSTANG/LICENSE_MUSTANG.txt | 34 + .../paraMUSTANGV1_Sed_toy.txt | 77 + .../paraMUSTANGV1_Sed_toy_floc_0d.txt | 94 + .../paraMUSTANGV1_Sed_toy_floc_1d.txt | 94 + .../paraMUSTANGV1_Tidal_flat.txt | 82 + .../paraMUSTANGV1_estuary.txt | 82 + .../paraMUSTANGV1_vilaine.txt | 110 + .../paraMUSTANGV2_Ana_dune.txt | 85 + .../MUSTANG_NAMELIST/paraMUSTANGV2_Dune.txt | 86 + .../MUSTANG_NAMELIST/paraMUSTANG_default.txt | 677 + .../parasubstance_MUSTANG_Ana_dune.txt | 94 + .../parasubstance_MUSTANG_Dune.txt | 94 + .../parasubstance_MUSTANG_Sed_toy.txt | 190 + .../parasubstance_MUSTANG_Sed_toy_floc_0d.txt | 388 + .../parasubstance_MUSTANG_Sed_toy_floc_1d.txt | 388 + .../parasubstance_MUSTANG_Tidal_flat.txt | 154 + .../parasubstance_MUSTANG_estuary.txt | 132 + .../parasubstance_MUSTANG_full_example.txt | 381 + .../parasubstance_MUSTANG_vilaine.txt | 193 + CROCO/croco-v1.3.1/MUSTANG/comMUSTANG.F90 | 627 + CROCO/croco-v1.3.1/MUSTANG/comsubstance.F90 | 130 + .../croco-v1.3.1/MUSTANG/coupler_MUSTANG.F90 | 214 + .../MUSTANG/coupler_define_MUSTANG.h | 144 + CROCO/croco-v1.3.1/MUSTANG/flocmod.F90 | 887 ++ CROCO/croco-v1.3.1/MUSTANG/initMUSTANG.F90 | 1696 ++ CROCO/croco-v1.3.1/MUSTANG/module_MUSTANG.F | 20 + CROCO/croco-v1.3.1/MUSTANG/module_substance.F | 22 + .../MUSTANG/plug_MUSTANG_CROCO.F90 | 98 + CROCO/croco-v1.3.1/MUSTANG/sed_MUSTANG.F90 | 8821 +++++++++++ .../MUSTANG/sed_MUSTANG_CROCO.F90 | 1196 ++ CROCO/croco-v1.3.1/MUSTANG/substance.F90 | 1416 ++ .../MUSTANG/t3dmix_tridiagonal_settling.h | 267 + CROCO/croco-v1.3.1/OCEAN/AGRIF_FixedGrids.in | 8 + CROCO/croco-v1.3.1/OCEAN/Agrif2Model.F | 75 + CROCO/croco-v1.3.1/OCEAN/FCT.h | 165 + CROCO/croco-v1.3.1/OCEAN/MPI_Setup.F | 502 + CROCO/croco-v1.3.1/OCEAN/Makedefs.generic | 45 + .../croco-v1.3.1/OCEAN/Makedefs.generic.AGRIF | 58 + CROCO/croco-v1.3.1/OCEAN/Makefile | 297 + CROCO/croco-v1.3.1/OCEAN/MessPass2D.F | 380 + CROCO/croco-v1.3.1/OCEAN/MessPass3D.F | 437 + CROCO/croco-v1.3.1/OCEAN/ab_ratio.F | 108 + CROCO/croco-v1.3.1/OCEAN/agrif_ext.h | 45 + CROCO/croco-v1.3.1/OCEAN/alfabeta.F | 156 + CROCO/croco-v1.3.1/OCEAN/alfabeta_k.F | 158 + CROCO/croco-v1.3.1/OCEAN/amr.in | 20 + CROCO/croco-v1.3.1/OCEAN/ana_grid.F | 1129 ++ CROCO/croco-v1.3.1/OCEAN/ana_initial.F | 2208 +++ CROCO/croco-v1.3.1/OCEAN/ana_vmix.F | 146 + CROCO/croco-v1.3.1/OCEAN/analytical.F | 3548 +++++ CROCO/croco-v1.3.1/OCEAN/autotiling.F | 315 + CROCO/croco-v1.3.1/OCEAN/autotiling.h | 40 + CROCO/croco-v1.3.1/OCEAN/averages.h | 174 + CROCO/croco-v1.3.1/OCEAN/bbl.F | 756 + CROCO/croco-v1.3.1/OCEAN/bbl.h | 72 + CROCO/croco-v1.3.1/OCEAN/bio_BioEBUS.F | 1501 ++ CROCO/croco-v1.3.1/OCEAN/bio_N2ChlPZD2.F | 618 + CROCO/croco-v1.3.1/OCEAN/bio_NChlPZD.F | 704 + CROCO/croco-v1.3.1/OCEAN/bio_diag.F | 187 + CROCO/croco-v1.3.1/OCEAN/biology.F | 25 + CROCO/croco-v1.3.1/OCEAN/boundary.h | 416 + CROCO/croco-v1.3.1/OCEAN/buffer.h | 34 + CROCO/croco-v1.3.1/OCEAN/bulk_flux.F | 818 + CROCO/croco-v1.3.1/OCEAN/bvf_mix.F | 92 + CROCO/croco-v1.3.1/OCEAN/check_kwds.F | 68 + CROCO/croco-v1.3.1/OCEAN/check_switches2.F | 106 + CROCO/croco-v1.3.1/OCEAN/checkdims.F | 101 + CROCO/croco-v1.3.1/OCEAN/checkkwds.F | 181 + CROCO/croco-v1.3.1/OCEAN/climat.h | 197 + CROCO/croco-v1.3.1/OCEAN/clm_tides.F | 652 + CROCO/croco-v1.3.1/OCEAN/closecdf.F | 185 + .../OCEAN/compute_auxiliary_bounds.h | 93 + .../OCEAN/compute_extended_bounds.h | 103 + .../OCEAN/compute_horiz_tracer_fluxes.h | 276 + .../OCEAN/compute_message_bounds.h | 55 + .../OCEAN/compute_starts_counts.h | 126 + .../croco-v1.3.1/OCEAN/compute_tile_bounds.h | 65 + .../OCEAN/compute_vert_tracer_fluxes.h | 197 + CROCO/croco-v1.3.1/OCEAN/coupling.h | 42 + CROCO/croco-v1.3.1/OCEAN/cpl_prism_define.F | 280 + CROCO/croco-v1.3.1/OCEAN/cpl_prism_get.F | 691 + CROCO/croco-v1.3.1/OCEAN/cpl_prism_getvar.F | 116 + CROCO/croco-v1.3.1/OCEAN/cpl_prism_grid.F | 226 + CROCO/croco-v1.3.1/OCEAN/cpl_prism_init.F | 61 + CROCO/croco-v1.3.1/OCEAN/cpl_prism_put.F | 206 + CROCO/croco-v1.3.1/OCEAN/cppcheck.F | 283 + CROCO/croco-v1.3.1/OCEAN/cppdefs.h | 1940 +++ CROCO/croco-v1.3.1/OCEAN/cppdefs_dev.h | 1110 ++ CROCO/croco-v1.3.1/OCEAN/croco.in | 276 + CROCO/croco-v1.3.1/OCEAN/croco.in.1 | 275 + CROCO/croco-v1.3.1/OCEAN/croco_forecast.in | 273 + CROCO/croco-v1.3.1/OCEAN/croco_hindcast.in | 272 + CROCO/croco-v1.3.1/OCEAN/croco_inter.in | 270 + CROCO/croco-v1.3.1/OCEAN/croco_inter.in.1 | 271 + CROCO/croco-v1.3.1/OCEAN/croco_oa.F90 | 373 + CROCO/croco-v1.3.1/OCEAN/croco_stations.in | 38 + CROCO/croco-v1.3.1/OCEAN/cross_matrix.F | 400 + CROCO/croco-v1.3.1/OCEAN/cste_bio_coastal.h | 137 + CROCO/croco-v1.3.1/OCEAN/debug.F | 414 + CROCO/croco-v1.3.1/OCEAN/debug_indices.h | 39 + CROCO/croco-v1.3.1/OCEAN/def_bio_diags.F | 640 + CROCO/croco-v1.3.1/OCEAN/def_bounds.h | 10 + CROCO/croco-v1.3.1/OCEAN/def_diags.F | 1228 ++ CROCO/croco-v1.3.1/OCEAN/def_diagsM.F | 1398 ++ CROCO/croco-v1.3.1/OCEAN/def_diags_eddy.F | 1186 ++ CROCO/croco-v1.3.1/OCEAN/def_diags_ek.F | 1760 +++ CROCO/croco-v1.3.1/OCEAN/def_diags_pv.F | 742 + CROCO/croco-v1.3.1/OCEAN/def_diags_vrt.F | 1120 ++ CROCO/croco-v1.3.1/OCEAN/def_floats.F | 696 + CROCO/croco-v1.3.1/OCEAN/def_grid_2d.F | 310 + CROCO/croco-v1.3.1/OCEAN/def_grid_3d.F | 398 + CROCO/croco-v1.3.1/OCEAN/def_his.F | 3555 +++++ CROCO/croco-v1.3.1/OCEAN/def_rst.F | 1757 +++ CROCO/croco-v1.3.1/OCEAN/def_sta.F | 842 + CROCO/croco-v1.3.1/OCEAN/def_surf.F | 732 + CROCO/croco-v1.3.1/OCEAN/diag.F | 387 + CROCO/croco-v1.3.1/OCEAN/diag_vars.h | 10 + CROCO/croco-v1.3.1/OCEAN/diagnostics.h | 281 + CROCO/croco-v1.3.1/OCEAN/diags_eddy.h | 59 + CROCO/croco-v1.3.1/OCEAN/diags_ek.h | 329 + CROCO/croco-v1.3.1/OCEAN/diags_pv.h | 91 + CROCO/croco-v1.3.1/OCEAN/diags_vrt.h | 167 + CROCO/croco-v1.3.1/OCEAN/dynderivparam.h | 86 + CROCO/croco-v1.3.1/OCEAN/dynparam.h | 24 + CROCO/croco-v1.3.1/OCEAN/dynparam_f77.h | 57 + CROCO/croco-v1.3.1/OCEAN/exchange.F | 109 + CROCO/croco-v1.3.1/OCEAN/exchange_2d_tile.h | 137 + CROCO/croco-v1.3.1/OCEAN/exchange_3d_tile.h | 156 + CROCO/croco-v1.3.1/OCEAN/fillvalue.F | 406 + .../OCEAN/finalize_diagnostics_tsadv.h | 25 + CROCO/croco-v1.3.1/OCEAN/floats.h | 99 + CROCO/croco-v1.3.1/OCEAN/floats.in | 1032 ++ CROCO/croco-v1.3.1/OCEAN/floats.in.River | 10 + CROCO/croco-v1.3.1/OCEAN/floats.in_README | 51 + CROCO/croco-v1.3.1/OCEAN/forces.h | 714 + CROCO/croco-v1.3.1/OCEAN/get_bry.F | 701 + CROCO/croco-v1.3.1/OCEAN/get_bry_bio.F | 951 ++ CROCO/croco-v1.3.1/OCEAN/get_bry_wkb.F | 322 + CROCO/croco-v1.3.1/OCEAN/get_btflux.F | 288 + CROCO/croco-v1.3.1/OCEAN/get_bulk.F | 871 + CROCO/croco-v1.3.1/OCEAN/get_date.F | 238 + CROCO/croco-v1.3.1/OCEAN/get_grid.F | 369 + CROCO/croco-v1.3.1/OCEAN/get_initial.F | 1191 ++ CROCO/croco-v1.3.1/OCEAN/get_initial_floats.F | 165 + CROCO/croco-v1.3.1/OCEAN/get_psource.F | 241 + CROCO/croco-v1.3.1/OCEAN/get_psource_ts.F | 925 ++ CROCO/croco-v1.3.1/OCEAN/get_smflux.F | 348 + CROCO/croco-v1.3.1/OCEAN/get_srflux.F | 420 + CROCO/croco-v1.3.1/OCEAN/get_ssh.F | 239 + CROCO/croco-v1.3.1/OCEAN/get_sss.F | 307 + CROCO/croco-v1.3.1/OCEAN/get_sst.F | 286 + CROCO/croco-v1.3.1/OCEAN/get_stflux.F | 281 + CROCO/croco-v1.3.1/OCEAN/get_tclima.F | 818 + CROCO/croco-v1.3.1/OCEAN/get_tides.F | 280 + CROCO/croco-v1.3.1/OCEAN/get_uclima.F | 311 + CROCO/croco-v1.3.1/OCEAN/get_vbc.F | 791 + CROCO/croco-v1.3.1/OCEAN/get_wwave.F | 730 + CROCO/croco-v1.3.1/OCEAN/gls_mixing.F | 981 ++ CROCO/croco-v1.3.1/OCEAN/gls_smooth.h | 78 + CROCO/croco-v1.3.1/OCEAN/gls_stab_func.h | 151 + CROCO/croco-v1.3.1/OCEAN/grid.h | 200 + CROCO/croco-v1.3.1/OCEAN/grid_nbq.F | 187 + CROCO/croco-v1.3.1/OCEAN/grid_stiffness.F | 149 + CROCO/croco-v1.3.1/OCEAN/hmix_coef.F | 612 + CROCO/croco-v1.3.1/OCEAN/init_arrays.F | 1487 ++ CROCO/croco-v1.3.1/OCEAN/init_arrays_floats.F | 60 + CROCO/croco-v1.3.1/OCEAN/init_arrays_sta.F | 52 + CROCO/croco-v1.3.1/OCEAN/init_floats.F | 559 + CROCO/croco-v1.3.1/OCEAN/init_floats.h | 34 + CROCO/croco-v1.3.1/OCEAN/init_scalars.F | 4734 ++++++ CROCO/croco-v1.3.1/OCEAN/init_sta.F | 528 + CROCO/croco-v1.3.1/OCEAN/init_sta.h | 29 + CROCO/croco-v1.3.1/OCEAN/initfloats.m | 95 + CROCO/croco-v1.3.1/OCEAN/initial_nbq.F | 295 + CROCO/croco-v1.3.1/OCEAN/insert_node.F | 300 + CROCO/croco-v1.3.1/OCEAN/interp_rho.F | 187 + CROCO/croco-v1.3.1/OCEAN/interp_sta.F | 191 + CROCO/croco-v1.3.1/OCEAN/jobcomp | 336 + CROCO/croco-v1.3.1/OCEAN/kpp_smooth.h | 77 + CROCO/croco-v1.3.1/OCEAN/lenstr.F | 36 + CROCO/croco-v1.3.1/OCEAN/lmd_bkpp.F | 26 + CROCO/croco-v1.3.1/OCEAN/lmd_bkpp1994.F | 439 + CROCO/croco-v1.3.1/OCEAN/lmd_bkpp2005.F | 414 + CROCO/croco-v1.3.1/OCEAN/lmd_kpp.h | 15 + CROCO/croco-v1.3.1/OCEAN/lmd_skpp.F | 26 + CROCO/croco-v1.3.1/OCEAN/lmd_skpp1994.F | 655 + CROCO/croco-v1.3.1/OCEAN/lmd_skpp2005.F | 585 + CROCO/croco-v1.3.1/OCEAN/lmd_swfrac.F | 230 + CROCO/croco-v1.3.1/OCEAN/lmd_vmix.F | 797 + CROCO/croco-v1.3.1/OCEAN/lmd_wscale.F | 224 + .../croco-v1.3.1/OCEAN/lmd_wscale_wm_and_ws.h | 58 + CROCO/croco-v1.3.1/OCEAN/lmd_wscale_ws_only.h | 68 + CROCO/croco-v1.3.1/OCEAN/main.F | 961 ++ CROCO/croco-v1.3.1/OCEAN/mas.F | 467 + CROCO/croco-v1.3.1/OCEAN/mixing.h | 183 + CROCO/croco-v1.3.1/OCEAN/mod_tides_mas.F | 106 + CROCO/croco-v1.3.1/OCEAN/module_checkmpi.F90 | 91 + CROCO/croco-v1.3.1/OCEAN/module_grd_oa.F90 | 321 + .../OCEAN/module_oa_interface.F90 | 9600 ++++++++++++ CROCO/croco-v1.3.1/OCEAN/module_oa_level.F90 | 56 + .../croco-v1.3.1/OCEAN/module_oa_periode.F90 | 117 + CROCO/croco-v1.3.1/OCEAN/module_oa_space.F90 | 66 + CROCO/croco-v1.3.1/OCEAN/module_oa_time.F90 | 67 + CROCO/croco-v1.3.1/OCEAN/module_oa_type.F90 | 68 + .../OCEAN/module_oa_variables.F90 | 102 + CROCO/croco-v1.3.1/OCEAN/module_ocean3d.F | 10 + CROCO/croco-v1.3.1/OCEAN/module_param.F | 9 + .../OCEAN/module_parameter_oa.F90 | 115 + CROCO/croco-v1.3.1/OCEAN/module_qsort.F90 | 299 + CROCO/croco-v1.3.1/OCEAN/module_scalars.F | 10 + CROCO/croco-v1.3.1/OCEAN/module_tile_oa.F90 | 371 + .../OCEAN/module_tracetxt_out.F90 | 160 + CROCO/croco-v1.3.1/OCEAN/mpc.F | 1069 ++ CROCO/croco-v1.3.1/OCEAN/mpi_cpl.h | 40 + CROCO/croco-v1.3.1/OCEAN/mrl_wci.F | 1402 ++ CROCO/croco-v1.3.1/OCEAN/nbq.h | 271 + CROCO/croco-v1.3.1/OCEAN/nbq_bry_store.F | 192 + CROCO/croco-v1.3.1/OCEAN/nc_sta.h | 85 + CROCO/croco-v1.3.1/OCEAN/ncjoin.F | 2007 +++ CROCO/croco-v1.3.1/OCEAN/ncrename.F | 149 + CROCO/croco-v1.3.1/OCEAN/ncscrum.F | 5 + CROCO/croco-v1.3.1/OCEAN/ncscrum.h | 2134 +++ CROCO/croco-v1.3.1/OCEAN/ncscrum_floats.h | 106 + CROCO/croco-v1.3.1/OCEAN/nf_add_attribute.F | 95 + CROCO/croco-v1.3.1/OCEAN/nf_fread.F | 263 + CROCO/croco-v1.3.1/OCEAN/nf_fread_x.F | 123 + CROCO/croco-v1.3.1/OCEAN/nf_fread_y.F | 124 + CROCO/croco-v1.3.1/OCEAN/nf_read_bry.F | 115 + CROCO/croco-v1.3.1/OCEAN/o2sato.F | 83 + CROCO/croco-v1.3.1/OCEAN/obc_volcons.F | 312 + CROCO/croco-v1.3.1/OCEAN/ocean2d.h | 31 + CROCO/croco-v1.3.1/OCEAN/ocean3d.h | 91 + CROCO/croco-v1.3.1/OCEAN/omega.F | 352 + CROCO/croco-v1.3.1/OCEAN/online.h | 71 + CROCO/croco-v1.3.1/OCEAN/online_bulk_var.F | 304 + CROCO/croco-v1.3.1/OCEAN/online_get_bulk.F | 552 + CROCO/croco-v1.3.1/OCEAN/online_interp.F | 574 + .../OCEAN/online_interpolate_bulk.F | 351 + CROCO/croco-v1.3.1/OCEAN/online_set_bulk.F | 245 + .../OCEAN/online_spectral_diags.F | 483 + CROCO/croco-v1.3.1/OCEAN/output.F | 424 + CROCO/croco-v1.3.1/OCEAN/output_oa.F | 444 + CROCO/croco-v1.3.1/OCEAN/param.F | 4 + CROCO/croco-v1.3.1/OCEAN/param.h | 1007 ++ .../OCEAN/parameter.passivetrc.pisces.h | 57 + CROCO/croco-v1.3.1/OCEAN/params_bulk.h | 128 + CROCO/croco-v1.3.1/OCEAN/partit.F | 826 + .../OCEAN/partit.F_optim_nocompatible_bryfile | 1191 ++ CROCO/croco-v1.3.1/OCEAN/pre_step3d.F | 1051 ++ CROCO/croco-v1.3.1/OCEAN/private_scratch.h | 28 + .../croco-v1.3.1/OCEAN/private_scratch_AMR.h | 42 + CROCO/croco-v1.3.1/OCEAN/prsgrd.F | 936 ++ CROCO/croco-v1.3.1/OCEAN/put_global_atts.F | 637 + CROCO/croco-v1.3.1/OCEAN/random_walk.F | 354 + CROCO/croco-v1.3.1/OCEAN/read_inp.F | 2919 ++++ CROCO/croco-v1.3.1/OCEAN/rho_eos.F | 663 + CROCO/croco-v1.3.1/OCEAN/rhs3d.F | 1849 +++ CROCO/croco-v1.3.1/OCEAN/rhs3d_w_nh.F | 834 + CROCO/croco-v1.3.1/OCEAN/rhs_floats.F | 253 + CROCO/croco-v1.3.1/OCEAN/rnbq_bc.F | 608 + CROCO/croco-v1.3.1/OCEAN/scal0d_oa_out_full.F | 367 + CROCO/croco-v1.3.1/OCEAN/scal0d_oa_out_loc.F | 383 + CROCO/croco-v1.3.1/OCEAN/scalars.F | 6 + CROCO/croco-v1.3.1/OCEAN/scalars.h | 599 + CROCO/croco-v1.3.1/OCEAN/scalars_F90.h | 604 + CROCO/croco-v1.3.1/OCEAN/sediment.F | 5282 +++++++ CROCO/croco-v1.3.1/OCEAN/sediment.h | 206 + CROCO/croco-v1.3.1/OCEAN/sediment.in | 90 + CROCO/croco-v1.3.1/OCEAN/set_avg.F | 890 ++ CROCO/croco-v1.3.1/OCEAN/set_bio_diags_avg.F | 158 + CROCO/croco-v1.3.1/OCEAN/set_cycle.F | 220 + CROCO/croco-v1.3.1/OCEAN/set_depth.F | 739 + CROCO/croco-v1.3.1/OCEAN/set_diagsM_avg.F | 652 + CROCO/croco-v1.3.1/OCEAN/set_diags_avg.F | 170 + CROCO/croco-v1.3.1/OCEAN/set_diags_eddy_avg.F | 209 + CROCO/croco-v1.3.1/OCEAN/set_diags_ek.F | 187 + CROCO/croco-v1.3.1/OCEAN/set_diags_ek_avg.F | 644 + CROCO/croco-v1.3.1/OCEAN/set_diags_pv.F | 91 + CROCO/croco-v1.3.1/OCEAN/set_diags_pv_avg.F | 140 + CROCO/croco-v1.3.1/OCEAN/set_diags_vrt.F | 306 + CROCO/croco-v1.3.1/OCEAN/set_diags_vrt_avg.F | 373 + .../OCEAN/set_global_definitions.h | 365 + CROCO/croco-v1.3.1/OCEAN/set_nudgcof.F | 290 + CROCO/croco-v1.3.1/OCEAN/set_nudgcof_fine.F | 200 + .../croco-v1.3.1/OCEAN/set_obc_definitions.h | 257 + CROCO/croco-v1.3.1/OCEAN/set_scoord.F | 146 + CROCO/croco-v1.3.1/OCEAN/set_surf_avg.F | 198 + CROCO/croco-v1.3.1/OCEAN/set_weights.F | 393 + CROCO/croco-v1.3.1/OCEAN/setup_grid1.F | 318 + CROCO/croco-v1.3.1/OCEAN/setup_grid2.F | 321 + CROCO/croco-v1.3.1/OCEAN/sources.h | 108 + CROCO/croco-v1.3.1/OCEAN/spkitlocal_nh.F90 | 1216 ++ CROCO/croco-v1.3.1/OCEAN/srcscheck.F | 130 + CROCO/croco-v1.3.1/OCEAN/sstskin.F | 191 + CROCO/croco-v1.3.1/OCEAN/sta.h | 79 + CROCO/croco-v1.3.1/OCEAN/stations.in | 39 + CROCO/croco-v1.3.1/OCEAN/step.F | 1189 ++ CROCO/croco-v1.3.1/OCEAN/step2d.F | 1906 +++ CROCO/croco-v1.3.1/OCEAN/step3d_fast.F | 4166 +++++ CROCO/croco-v1.3.1/OCEAN/step3d_t.F | 1292 ++ CROCO/croco-v1.3.1/OCEAN/step3d_uv1.F | 157 + CROCO/croco-v1.3.1/OCEAN/step3d_uv2.F | 2444 +++ CROCO/croco-v1.3.1/OCEAN/step3d_w.F | 218 + CROCO/croco-v1.3.1/OCEAN/step_floats.F | 613 + CROCO/croco-v1.3.1/OCEAN/step_sta.F | 272 + CROCO/croco-v1.3.1/OCEAN/strings.h | 19 + CROCO/croco-v1.3.1/OCEAN/surf.h | 30 + CROCO/croco-v1.3.1/OCEAN/t3dadv_order5.h | 240 + CROCO/croco-v1.3.1/OCEAN/t3dbc.F | 593 + CROCO/croco-v1.3.1/OCEAN/t3dmix.F | 24 + CROCO/croco-v1.3.1/OCEAN/t3dmix_ISO.F | 1080 ++ CROCO/croco-v1.3.1/OCEAN/t3dmix_S.F | 582 + CROCO/croco-v1.3.1/OCEAN/t3dmix_spg.F | 870 + CROCO/croco-v1.3.1/OCEAN/t3dmix_tridiagonal.h | 278 + CROCO/croco-v1.3.1/OCEAN/t3dpremix.F | 252 + CROCO/croco-v1.3.1/OCEAN/testkeys | 10 + CROCO/croco-v1.3.1/OCEAN/testkeys.F | 32 + CROCO/croco-v1.3.1/OCEAN/tidedata.F | 1388 ++ CROCO/croco-v1.3.1/OCEAN/tides.h | 80 + CROCO/croco-v1.3.1/OCEAN/timers_roms.F | 82 + CROCO/croco-v1.3.1/OCEAN/tooldatetosec.F90 | 92 + CROCO/croco-v1.3.1/OCEAN/tooldatosec.F90 | 90 + CROCO/croco-v1.3.1/OCEAN/tooldecompdat.F90 | 65 + CROCO/croco-v1.3.1/OCEAN/toolorigindate.F90 | 77 + CROCO/croco-v1.3.1/OCEAN/toolsectodat.F90 | 125 + CROCO/croco-v1.3.1/OCEAN/tridiag_pred.h | 159 + CROCO/croco-v1.3.1/OCEAN/u2dbc.F | 965 ++ CROCO/croco-v1.3.1/OCEAN/u3dbc.F | 577 + CROCO/croco-v1.3.1/OCEAN/u_hadv_order5.h | 261 + CROCO/croco-v1.3.1/OCEAN/u_vadv_order5.h | 88 + CROCO/croco-v1.3.1/OCEAN/uhdiff_order5.h | 261 + CROCO/croco-v1.3.1/OCEAN/unbq_bc.F | 730 + CROCO/croco-v1.3.1/OCEAN/update2D.F | 1126 ++ CROCO/croco-v1.3.1/OCEAN/update3D.F | 880 ++ CROCO/croco-v1.3.1/OCEAN/uv3dmix.F | 25 + CROCO/croco-v1.3.1/OCEAN/uv3dmix4_GP.F | 1086 ++ CROCO/croco-v1.3.1/OCEAN/uv3dmix4_S.F | 550 + CROCO/croco-v1.3.1/OCEAN/uv3dmix_GP.F | 612 + CROCO/croco-v1.3.1/OCEAN/uv3dmix_S.F | 372 + CROCO/croco-v1.3.1/OCEAN/uv3dmix_spg.F | 919 ++ CROCO/croco-v1.3.1/OCEAN/uv3dpremix.F | 419 + CROCO/croco-v1.3.1/OCEAN/uvhadv_tvd.h | 95 + CROCO/croco-v1.3.1/OCEAN/v2dbc.F | 960 ++ CROCO/croco-v1.3.1/OCEAN/v3dbc.F | 576 + CROCO/croco-v1.3.1/OCEAN/v_hadv_order5.h | 260 + CROCO/croco-v1.3.1/OCEAN/v_vadv_order5.h | 89 + CROCO/croco-v1.3.1/OCEAN/var2d_oa_out.F | 478 + CROCO/croco-v1.3.1/OCEAN/var3d_oa_out.F | 484 + CROCO/croco-v1.3.1/OCEAN/var_oa.F90 | 183 + CROCO/croco-v1.3.1/OCEAN/vhdiff_order5.h | 260 + CROCO/croco-v1.3.1/OCEAN/vnbq_bc.F | 734 + CROCO/croco-v1.3.1/OCEAN/w3dbc.F | 578 + CROCO/croco-v1.3.1/OCEAN/w_hadv_order5.h | 200 + CROCO/croco-v1.3.1/OCEAN/w_vadv_order5.h | 33 + CROCO/croco-v1.3.1/OCEAN/wave_maker.h | 602 + .../croco-v1.3.1/OCEAN/wave_maker_internal.h | 200 + CROCO/croco-v1.3.1/OCEAN/wavedry.F | 116 + CROCO/croco-v1.3.1/OCEAN/wetdry.F | 420 + CROCO/croco-v1.3.1/OCEAN/wkb_wwave.F | 1500 ++ CROCO/croco-v1.3.1/OCEAN/wkb_wwave.h | 61 + CROCO/croco-v1.3.1/OCEAN/wkbbc.F | 262 + CROCO/croco-v1.3.1/OCEAN/wnbq_bc.F | 605 + CROCO/croco-v1.3.1/OCEAN/work.h | 29 + CROCO/croco-v1.3.1/OCEAN/wrt_avg.F | 977 ++ CROCO/croco-v1.3.1/OCEAN/wrt_bio_diags.F | 222 + CROCO/croco-v1.3.1/OCEAN/wrt_bio_diags_avg.F | 223 + CROCO/croco-v1.3.1/OCEAN/wrt_diags.F | 357 + CROCO/croco-v1.3.1/OCEAN/wrt_diagsM.F | 396 + CROCO/croco-v1.3.1/OCEAN/wrt_diagsM_avg.F | 405 + CROCO/croco-v1.3.1/OCEAN/wrt_diags_avg.F | 360 + CROCO/croco-v1.3.1/OCEAN/wrt_diags_eddy_avg.F | 286 + CROCO/croco-v1.3.1/OCEAN/wrt_diags_ek.F | 432 + CROCO/croco-v1.3.1/OCEAN/wrt_diags_ek_avg.F | 450 + CROCO/croco-v1.3.1/OCEAN/wrt_diags_pv.F | 242 + CROCO/croco-v1.3.1/OCEAN/wrt_diags_pv_avg.F | 246 + CROCO/croco-v1.3.1/OCEAN/wrt_diags_vrt.F | 313 + CROCO/croco-v1.3.1/OCEAN/wrt_diags_vrt_avg.F | 339 + CROCO/croco-v1.3.1/OCEAN/wrt_floats.F | 431 + CROCO/croco-v1.3.1/OCEAN/wrt_grid.F | 296 + CROCO/croco-v1.3.1/OCEAN/wrt_his.F | 1403 ++ CROCO/croco-v1.3.1/OCEAN/wrt_rst.F | 822 + CROCO/croco-v1.3.1/OCEAN/wrt_sta.F | 524 + CROCO/croco-v1.3.1/OCEAN/wrt_surf.F | 221 + CROCO/croco-v1.3.1/OCEAN/wrt_surf_avg.F | 237 + CROCO/croco-v1.3.1/OCEAN/wvlcty.F | 230 + CROCO/croco-v1.3.1/OCEAN/zetabc.F | 434 + CROCO/croco-v1.3.1/OCEAN/zonavg.F | 113 + CROCO/croco-v1.3.1/OCEAN/zoom.F | 3144 ++++ CROCO/croco-v1.3.1/OCEAN/zoom.h | 345 + CROCO/croco-v1.3.1/OCEAN/zoombc_2D.F | 1670 ++ CROCO/croco-v1.3.1/OCEAN/zoombc_3D.F | 1203 ++ CROCO/croco-v1.3.1/OCEAN/zoombc_3Dfast.F | 989 ++ CROCO/croco-v1.3.1/PISCES/README | 0 .../PISCES/SED/namelist_sediment_cfg | 50 + .../PISCES/SED/namelist_sediment_ref | 132 + CROCO/croco-v1.3.1/PISCES/SED/oce_sed.F90 | 41 + CROCO/croco-v1.3.1/PISCES/SED/par_sed.F90 | 68 + CROCO/croco-v1.3.1/PISCES/SED/sed.F90 | 189 + CROCO/croco-v1.3.1/PISCES/SED/sed_oce.F90 | 45 + CROCO/croco-v1.3.1/PISCES/SED/sedadv.F90 | 446 + CROCO/croco-v1.3.1/PISCES/SED/sedarr.F90 | 128 + CROCO/croco-v1.3.1/PISCES/SED/sedbtb.F90 | 81 + CROCO/croco-v1.3.1/PISCES/SED/sedchem.F90 | 781 + CROCO/croco-v1.3.1/PISCES/SED/sedco3.F90 | 83 + CROCO/croco-v1.3.1/PISCES/SED/seddiff.F90 | 123 + CROCO/croco-v1.3.1/PISCES/SED/seddsr.F90 | 760 + CROCO/croco-v1.3.1/PISCES/SED/seddta.F90 | 220 + CROCO/croco-v1.3.1/PISCES/SED/sedini.F90 | 727 + CROCO/croco-v1.3.1/PISCES/SED/sedinitrc.F90 | 197 + CROCO/croco-v1.3.1/PISCES/SED/sedinorg.F90 | 303 + CROCO/croco-v1.3.1/PISCES/SED/sedmat.F90 | 263 + CROCO/croco-v1.3.1/PISCES/SED/sedmbc.F90 | 261 + CROCO/croco-v1.3.1/PISCES/SED/sedmodel.F90 | 47 + CROCO/croco-v1.3.1/PISCES/SED/sedorg.F90 | 162 + CROCO/croco-v1.3.1/PISCES/SED/sedrst.F90 | 852 + CROCO/croco-v1.3.1/PISCES/SED/sedsfc.F90 | 72 + CROCO/croco-v1.3.1/PISCES/SED/sedstp.F90 | 102 + CROCO/croco-v1.3.1/PISCES/SED/sedwri.F90 | 799 + CROCO/croco-v1.3.1/PISCES/SED/setavg_sed.F90 | 150 + CROCO/croco-v1.3.1/PISCES/biology_pisces.F | 89 + CROCO/croco-v1.3.1/PISCES/biology_pisces.F90 | 101 + CROCO/croco-v1.3.1/PISCES/kRGB61.txt | 61 + CROCO/croco-v1.3.1/PISCES/kRGB61.txt.1 | 61 + CROCO/croco-v1.3.1/PISCES/namelist_pisces_cfg | 101 + .../croco-v1.3.1/PISCES/namelist_pisces_cfg.1 | 101 + CROCO/croco-v1.3.1/PISCES/namelist_pisces_ref | 373 + .../croco-v1.3.1/PISCES/namelist_pisces_ref.1 | 373 + CROCO/croco-v1.3.1/PISCES/ocean2pisces.F90 | 413 + CROCO/croco-v1.3.1/PISCES/ocean2pisces.h90 | 137 + CROCO/croco-v1.3.1/PISCES/p4zagg.F90 | 203 + CROCO/croco-v1.3.1/PISCES/p4zbio.F90 | 125 + CROCO/croco-v1.3.1/PISCES/p4zche.F90 | 856 + CROCO/croco-v1.3.1/PISCES/p4zfechem.F90 | 316 + CROCO/croco-v1.3.1/PISCES/p4zflx.F90 | 256 + CROCO/croco-v1.3.1/PISCES/p4zint.F90 | 82 + CROCO/croco-v1.3.1/PISCES/p4zligand.F90 | 158 + CROCO/croco-v1.3.1/PISCES/p4zlim.F90 | 331 + CROCO/croco-v1.3.1/PISCES/p4zlys.F90 | 209 + CROCO/croco-v1.3.1/PISCES/p4zmeso.F90 | 371 + CROCO/croco-v1.3.1/PISCES/p4zmicro.F90 | 316 + CROCO/croco-v1.3.1/PISCES/p4zmort.F90 | 258 + CROCO/croco-v1.3.1/PISCES/p4zopt.F90 | 600 + CROCO/croco-v1.3.1/PISCES/p4zpoc.F90 | 970 ++ CROCO/croco-v1.3.1/PISCES/p4zprod.F90 | 602 + CROCO/croco-v1.3.1/PISCES/p4zrem.F90 | 407 + CROCO/croco-v1.3.1/PISCES/p4zsbc.F90 | 433 + CROCO/croco-v1.3.1/PISCES/p4zsed.F90 | 577 + CROCO/croco-v1.3.1/PISCES/p4zsink.F90 | 744 + CROCO/croco-v1.3.1/PISCES/p4zsms.F90 | 201 + CROCO/croco-v1.3.1/PISCES/p5zlim.F90 | 597 + CROCO/croco-v1.3.1/PISCES/p5zmeso.F90 | 505 + CROCO/croco-v1.3.1/PISCES/p5zmicro.F90 | 444 + CROCO/croco-v1.3.1/PISCES/p5zmort.F90 | 316 + CROCO/croco-v1.3.1/PISCES/p5zprod.F90 | 664 + CROCO/croco-v1.3.1/PISCES/par_pisces.F90 | 155 + CROCO/croco-v1.3.1/PISCES/pisces_ini.F90 | 44 + CROCO/croco-v1.3.1/PISCES/sms_pisces.F90 | 353 + CROCO/croco-v1.3.1/PISCES/top_substitute.h90 | 0 CROCO/croco-v1.3.1/PISCES/trc.F90 | 126 + CROCO/croco-v1.3.1/PISCES/trcini_pisces.F90 | 373 + CROCO/croco-v1.3.1/PISCES/trcsms_pisces.F90 | 64 + CROCO/croco-v1.3.1/PISCES/trcwri_pisces.F90 | 102 + CROCO/croco-v1.3.1/README.md | 75 + .../NAMELIST_OANALYSIS/namelist_Wavelet_M2_oa | 119 + .../NAMELIST_OANALYSIS/namelist_Wavelet_M4_oa | 119 + .../NAMELIST_OANALYSIS/namelist_kc_morlet_oa | 117 + .../namelist_marnage_morlet_oa | 117 + .../namelist_marnage_moyenne_oa | 117 + .../SCRIPTS/NAMELIST_OANALYSIS/namelist_oa | 55 + .../NAMELIST_OANALYSIS/namelist_oa.marnage | 54 + .../SCRIPTS/NAMELIST_OANALYSIS/namelist_oa.u | 54 + .../NAMELIST_OANALYSIS/namelist_oa.u.marnage | 54 + .../SCRIPTS/NAMELIST_OANALYSIS/namelist_oa_2 | 54 + .../NAMELIST_OANALYSIS/namelist_test_dirac_oa | 119 + .../namelist_test_morlet_oa | 118 + .../NAMELIST_OANALYSIS/namelist_u_dirac_oa | 118 + .../NAMELIST_OANALYSIS/namelist_u_morlet_oa | 118 + .../NAMELIST_OANALYSIS/namelist_w_dirac_oa | 118 + .../Plurimonths_scripts/run_croco.bash | 358 + .../run_croco_forecast.bash | 268 + .../Plurimonths_scripts/run_croco_inter.bash | 429 + .../SCRIPTS_COUPLING/CROCO_IN/croco.in.base | 192 + .../SCRIPTS_COUPLING/OASIS_IN/make.ADA | 73 + .../SCRIPTS_COUPLING/OASIS_IN/make.DATARMOR | 74 + .../OASIS_IN/namcouple.base.1o2a | 340 + .../OASIS_IN/namcouple.base.2o1a | 337 + .../OASIS_IN/namcouple.base.2o2a | 405 + .../OASIS_IN/namcouple.base.aw | 196 + .../OASIS_IN/namcouple.base.aw.debug | 196 + .../OASIS_IN/namcouple.base.aw.nointerp | 193 + .../OASIS_IN/namcouple.base.aw.toyatm | 196 + .../OASIS_IN/namcouple.base.aw.toywav | 196 + .../OASIS_IN/namcouple.base.oa | 267 + .../OASIS_IN/namcouple.base.oa.smtha2o | 267 + .../OASIS_IN/namcouple.base.oa.smtho2a | 267 + .../namcouple.base.oa.smtho2a.smtha2o | 267 + .../OASIS_IN/namcouple.base.oa.toyatm | 256 + .../namcouple.base.oa.toyatm.Add_psfc | 266 + .../OASIS_IN/namcouple.base.oa.toyoce | 267 + .../OASIS_IN/namcouple.base.ow | 228 + .../OASIS_IN/namcouple.base.ow.toyoce | 227 + .../OASIS_IN/namcouple.base.ow.toywav | 228 + .../OASIS_IN/namcouple.base.owa | 417 + .../OASIS_IN/namcouple.base.owa.instfield | 394 + .../OASIS_IN/namcouple.base.owa.toyatm | 417 + .../OASIS_IN/namcouple.base.owa.toyatm.toyoce | 417 + .../OASIS_IN/namcouple.base.owa.toyatm.toywav | 417 + .../OASIS_IN/namcouple.base.owa.toyoce | 417 + .../OASIS_IN/namcouple.base.owa.toywav | 417 + .../OASIS_IN/namcouple.base.owa.toywav.toyoce | 417 + .../SCRIPTS_COUPLING/README_coupling_tools | 68 + .../MACHINE/DATARMOR/header.DATARMOR | 13 + .../MACHINE/DATARMOR/launch_DATARMOR.sh | 35 + .../MACHINE/DATARMOR/myenv.DATARMOR | 32 + .../MACHINE/DATARMOR/myenv.DATARMOR.wrf | 12 + .../MACHINE/DATARMOR/myenv.DATARMOR.ww3 | 6 + .../MACHINE/IRENE/header.IRENE | 19 + .../MACHINE/IRENE/launch_IRENE.sh | 36 + .../SCRIPTS_TOOLBOX/MACHINE/IRENE/myenv.IRENE | 34 + .../MACHINE/IRENE/myenv.IRENE.wrf | 9 + .../MACHINE/IRENE/myenv.IRENE.ww3 | 3 + .../MACHINE/JEANZAY/header.JEANZAY | 18 + .../MACHINE/JEANZAY/launch_JEANZAY.sh | 65 + .../MACHINE/JEANZAY/myenv.JEANZAY | 32 + .../MACHINE/JEANZAY/myenv.JEANZAY.wrf | 12 + .../MACHINE/JEANZAY/myenv.JEANZAY.ww3 | 6 + .../MACHINE/LEFTRARU/header.LEFTRARU | 18 + .../MACHINE/LEFTRARU/launch_LEFTRARU.sh | 60 + .../MACHINE/LEFTRARU/myenv.LEFTRARU | 41 + .../MACHINE/LEFTRARU/myenv.LEFTRARU.wrf | 14 + .../MACHINE/LEFTRARU/myenv.LEFTRARU.ww3 | 5 + .../MACHINE/Linux/header.Linux | 6 + .../MACHINE/Linux/launch_Linux.sh | 35 + .../SCRIPTS_TOOLBOX/MACHINE/Linux/myenv.Linux | 47 + .../MACHINE/Linux/myenv.Linux.wrf | 12 + .../MACHINE/Linux/myenv.Linux.ww3 | 6 + .../NAMELISTS/mynamelist_full.sh_example | 202 + .../SCRIPTS_TOOLBOX/NAMELISTS/namelist_atm.sh | 59 + .../SCRIPTS_TOOLBOX/NAMELISTS/namelist_cpl.sh | 27 + .../NAMELISTS/namelist_head.sh | 7 + .../NAMELISTS/namelist_head_toy.sh | 8 + .../SCRIPTS_TOOLBOX/NAMELISTS/namelist_oce.sh | 44 + .../NAMELISTS/namelist_rundir.sh | 12 + .../NAMELISTS/namelist_tail.sh | 73 + .../SCRIPTS_TOOLBOX/NAMELISTS/namelist_toy.sh | 10 + .../SCRIPTS_TOOLBOX/NAMELISTS/namelist_wav.sh | 27 + .../NAMELISTS/namelist_xios.sh | 11 + .../create_oasis_grids_for_wrf.sh | 135 + ...eate_oasis_restart_from_calm_conditions.sh | 153 + ...s_restart_from_preexisting_output_files.sh | 171 + .../OASIS_SCRIPTS/create_oasis_toy_files.sh | 269 + .../OASIS_SCRIPTS/from_croco.sh | 156 + .../SCRIPTS_TOOLBOX/OASIS_SCRIPTS/from_wrf.sh | 172 + .../SCRIPTS_TOOLBOX/OASIS_SCRIPTS/from_ww3.sh | 117 + .../OASIS_SCRIPTS/mpmdconf_create.sh | 50 + .../OASIS_SCRIPTS/to_wrf_stag_grid.sh | 87 + .../SCRIPTS_TOOLBOX/PATHS/path_atm.sh | 6 + .../SCRIPTS_TOOLBOX/PATHS/path_base.sh | 24 + .../SCRIPTS_TOOLBOX/PATHS/path_cpl.sh | 4 + .../SCRIPTS_TOOLBOX/PATHS/path_oce.sh | 7 + .../SCRIPTS_TOOLBOX/PATHS/path_toy.sh | 5 + .../SCRIPTS_TOOLBOX/PATHS/path_wav.sh | 6 + .../SCRIPTS_TOOLBOX/PATHS/path_xios.sh | 5 + .../SCRIPTS_TOOLBOX/atm_getfile.sh | 166 + .../SCRIPTS_TOOLBOX/atm_getrst.sh | 98 + .../SCRIPTS_TOOLBOX/atm_nam.sh | 236 + .../SCRIPTS_TOOLBOX/atm_putfile.sh | 39 + .../SCRIPTS_TOOLBOX/caldat.sh | 219 + .../SCRIPTS_TOOLBOX/caltools.sh | 141 + .../SCRIPTS_TOOLBOX/chained_job.sh | 124 + .../SCRIPTS_TOOLBOX/common_definitions.sh | 57 + .../SCRIPTS_TOOLBOX/common_printing.sh | 39 + .../SCRIPTS_TOOLBOX/cpl_getfile.sh | 9 + .../SCRIPTS_TOOLBOX/cpl_getrst.sh | 128 + .../SCRIPTS_TOOLBOX/cpl_nam.sh | 135 + .../SCRIPTS_TOOLBOX/cpl_putfile.sh | 47 + .../SCRIPTS_TOOLBOX/getversion.sh | 61 + .../SCRIPTS_TOOLBOX/job.base.sh | 256 + .../SCRIPTS_TOOLBOX/julday.sh | 203 + .../SCRIPTS_TOOLBOX/oce_compile.sh | 217 + .../SCRIPTS_TOOLBOX/oce_getbdy.sh | 89 + .../SCRIPTS_TOOLBOX/oce_getfile.sh | 48 + .../SCRIPTS_TOOLBOX/oce_getfrc.sh | 155 + .../SCRIPTS_TOOLBOX/oce_getrst.sh | 77 + .../SCRIPTS_TOOLBOX/oce_nam.sh | 161 + .../SCRIPTS_TOOLBOX/oce_putfile.sh | 41 + .../SCRIPTS_TOOLBOX/toy_getfile.sh | 17 + .../SCRIPTS_TOOLBOX/toy_nam.sh | 37 + .../SCRIPTS_TOOLBOX/wav_getfile.sh | 85 + .../SCRIPTS_TOOLBOX/wav_getrst.sh | 85 + .../SCRIPTS_TOOLBOX/wav_putfile.sh | 55 + .../SCRIPTS_TOOLBOX/xios_process.sh | 31 + .../SCRIPTS/SCRIPTS_COUPLING/TOY_IN/Makefile | 85 + .../SCRIPTS_COUPLING/TOY_IN/Makefile.ADA | 83 + .../SCRIPTS_COUPLING/TOY_IN/Makefile.DATARMOR | 93 + .../SCRIPTS_COUPLING/TOY_IN/Makefile.IRENE | 85 + .../SCRIPTS_COUPLING/TOY_IN/Makefile.JEANZAY | 85 + .../SCRIPTS_COUPLING/TOY_IN/Makefile.LEFTRARU | 85 + .../TOY_IN/TOYNAMELIST.nam.atm.aw | 14 + .../TOY_IN/TOYNAMELIST.nam.atm.oa | 20 + .../TOY_IN/TOYNAMELIST.nam.atm.oa.Add_psfc | 21 + .../TOY_IN/TOYNAMELIST.nam.atm.owa | 24 + .../TOY_IN/TOYNAMELIST.nam.oce.oa | 21 + .../TOY_IN/TOYNAMELIST.nam.oce.ow | 17 + .../TOY_IN/TOYNAMELIST.nam.oce.ow.bck | 21 + .../TOY_IN/TOYNAMELIST.nam.oce.owa | 28 + .../TOY_IN/TOYNAMELIST.nam.wav.aw | 14 + .../TOY_IN/TOYNAMELIST.nam.wav.ow | 17 + .../TOY_IN/TOYNAMELIST.nam.wav.ow.bck | 21 + .../TOY_IN/TOYNAMELIST.nam.wav.owa | 24 + .../TOY_IN/TWOTOYNAMELIST.nam.atm.owa | 24 + .../TOY_IN/TWOTOYNAMELIST.nam.oce.owa | 29 + .../TOY_IN/TWOTOYNAMELIST.nam.wav.owa | 24 + .../SCRIPTS_COUPLING/TOY_IN/compile_toy.sh | 16 + .../SCRIPTS_COUPLING/TOY_IN/decomp_def.F90 | 52 + .../SCRIPTS_COUPLING/TOY_IN/function_sent.F90 | 59 + .../SCRIPTS_COUPLING/TOY_IN/read_dimgrid.F90 | 69 + .../SCRIPTS_COUPLING/TOY_IN/read_forcing.F90 | 74 + .../SCRIPTS_COUPLING/TOY_IN/read_grid.F90 | 98 + .../SCRIPTS_COUPLING/TOY_IN/read_namelist.F90 | 66 + .../SCRIPTS/SCRIPTS_COUPLING/TOY_IN/readme | 34 + .../TOY_IN/routine_hdlerr.F90 | 22 + .../SCRIPTS_COUPLING/TOY_IN/toy_model.F90 | 336 + .../WRF_IN/ADA.compile.wrf.ll | 17 + .../DATARMOR/configure.wrf.coupled | 581 + .../DATARMOR/configure.wrf.coupled_movingnest | 578 + ...ure.wrf.coupled_movingnest_terrain_landuse | 578 + .../DATARMOR/configure.wrf.coupled_xios | 584 + .../DATARMOR/configure.wrf.uncoupled | 574 + .../configure.wrf.uncoupled_movingnest | 574 + ...e.wrf.uncoupled_movingnest_terrain_landuse | 574 + .../DATARMOR/configure.wrf.uncoupled_xios | 580 + .../CONFIGURE_WRF/IRENE/configure.wrf.coupled | 556 + .../IRENE/configure.wrf.coupled_movingnest | 557 + ...ure.wrf.coupled_movingnest_terrain_landuse | 558 + .../IRENE/configure.wrf.coupled_xios | 566 + .../IRENE/configure.wrf.uncoupled | 553 + .../IRENE/configure.wrf.uncoupled_movingnest | 554 + ...e.wrf.uncoupled_movingnest_terrain_landuse | 553 + .../IRENE/configure.wrf.uncoupled_xios | 584 + .../JEANZAY/configure.wrf.coupled | 587 + .../JEANZAY/configure.wrf.coupled_movingnest | 588 + ...ure.wrf.coupled_movingnest_terrain_landuse | 588 + .../JEANZAY/configure.wrf.coupled_xios | 592 + .../JEANZAY/configure.wrf.uncoupled | 582 + .../configure.wrf.uncoupled_movingnest | 583 + ...e.wrf.uncoupled_movingnest_terrain_landuse | 582 + .../JEANZAY/configure.wrf.uncoupled_xios | 588 + .../LEFTRARU/configure.wrf.coupled | 557 + .../LEFTRARU/configure.wrf.uncoupled | 551 + .../CONFIGURE_WRF/Linux/configure.wrf.coupled | 553 + .../Linux/configure.wrf.uncoupled | 547 + .../WRF_IN/DATARMOR.compile.wrf.pbs | 11 + .../WRF_IN/IRENE.compile.wrf.sh | 17 + .../WRF_IN/JEANZAY.compile.wrf.slurm | 12 + .../WRF_IN/LEFTRARU.compile.wrf.slurm | 12 + .../SCRIPTS_COUPLING/WRF_IN/README.compile | 35 + .../SCRIPTS_COUPLING/WRF_IN/README.namelist | 1398 ++ .../WRF_IN/configure.namelist.real | 126 + .../SCRIPTS_COUPLING/WRF_IN/job.real.pbs | 8 + .../SCRIPTS_COUPLING/WRF_IN/job.real.sh | 19 + .../SCRIPTS_COUPLING/WRF_IN/job.real.slurm | 18 + .../WRF_IN/job.real.slurm.LEFTRARU | 18 + .../SCRIPTS_COUPLING/WRF_IN/make_WRF_compil | 98 + .../SCRIPTS_COUPLING/WRF_IN/myoutfields.txt | 2 + .../WRF_IN/namelist.input.base.complete | 201 + .../SCRIPTS_COUPLING/WRF_IN/run_real.bash | 399 + .../SCRIPTS_COUPLING/WW3_IN/make_WW3_compil | 138 + .../SCRIPTS/SCRIPTS_COUPLING/WW3_IN/switch_aw | 1 + .../SCRIPTS_COUPLING/WW3_IN/switch_frc | 1 + .../SCRIPTS/SCRIPTS_COUPLING/WW3_IN/switch_ow | 1 + .../SCRIPTS_COUPLING/WW3_IN/switch_owa | 1 + .../SCRIPTS_COUPLING/WW3_IN/ww3_bounc.inp | 26 + .../SCRIPTS_COUPLING/WW3_IN/ww3_grid.inp.base | 114 + .../SCRIPTS_COUPLING/WW3_IN/ww3_ounf.inp.base | 43 + .../SCRIPTS_COUPLING/WW3_IN/ww3_ounp.inp.base | 118 + .../WW3_IN/ww3_prnc.inp.current | 53 + .../WW3_IN/ww3_prnc.inp.level | 53 + .../SCRIPTS_COUPLING/WW3_IN/ww3_prnc.inp.wind | 53 + .../WW3_IN/ww3_shel.inp.base.Afrc | 115 + .../WW3_IN/ww3_shel.inp.base.aw | 115 + .../WW3_IN/ww3_shel.inp.base.frc | 115 + .../WW3_IN/ww3_shel.inp.base.ow | 115 + .../WW3_IN/ww3_shel.inp.base.owa | 115 + .../SCRIPTS_COUPLING/WW3_IN/ww3_strt.inp | 27 + .../SCRIPTS/SCRIPTS_COUPLING/myjob.sh | 124 + .../SCRIPTS/SCRIPTS_COUPLING/submitjob.sh | 129 + .../SCRIPTS/example_job_run_croco.pbs | 47 + .../SCRIPTS/example_job_run_croco.sh | 23 + .../SCRIPTS/example_job_run_croco.slurm | 22 + .../SCRIPTS/example_job_run_croco_inter.pbs | 48 + .../IGW_S2_rho_oa_MorletS2S4_200-240.gif | Bin 0 -> 14387211 bytes .../namelist_oa_rho__S2_S4 | 99 + .../namelist_rho__Wavelet_S2_oa | 119 + .../namelist_rho__Wavelet_S4_oa | 119 + ...ineAnalysis_Croco_Interface_validation.pdf | Bin 0 -> 5496533 bytes .../IGW_OA/MorletWaveletAnalysis/README | 3 + .../namelist_oa_test_1800s_900s | 121 + .../namelist_oa_test_S2 | 121 + .../namelist_oa_test_S2_S4 | 121 + .../namelist_oa_test_S4 | 121 + .../namelist_test_1800s_Wavelet_oa | 119 + .../namelist_test_900s_Wavelet_oa | 119 + .../namelist_test_Wavelet_S2_oa | 119 + ...elet_S2_oa.freq-analysis-600s.sampling150s | 119 + ...Wavelet_S2_oa.hourly-analysis.sampling150s | 119 + .../namelist_test_Wavelet_S4_oa | 119 + ...elet_S4_oa.freq-analysis-600s.sampling150s | 119 + ...Wavelet_S4_oa.hourly-analysis.sampling150s | 119 + .../IGW_OA/field_def.xml_full_xios2.5.IGW | 484 + ...le_def.xml.IGW.4days.S2S4.test_3d.4ts.600s | 59 + .../file_def.xml.IGW.8days.S2S4.rho_3d.hourly | 59 + CROCO/croco-v1.3.1/TEST_CASES/barocjet.m | 119 + CROCO/croco-v1.3.1/TEST_CASES/barocvortex.m | 107 + .../croco-v1.3.1/TEST_CASES/croco.in.Acoustic | 57 + .../croco-v1.3.1/TEST_CASES/croco.in.Ana_dune | 65 + CROCO/croco-v1.3.1/TEST_CASES/croco.in.Basin | 116 + CROCO/croco-v1.3.1/TEST_CASES/croco.in.Canyon | 43 + .../TEST_CASES/croco.in.DIURNALCYCLE | 172 + CROCO/croco-v1.3.1/TEST_CASES/croco.in.Dune | 62 + CROCO/croco-v1.3.1/TEST_CASES/croco.in.Dune3d | 59 + .../croco-v1.3.1/TEST_CASES/croco.in.Equator | 57 + .../croco-v1.3.1/TEST_CASES/croco.in.Estuary | 68 + .../TEST_CASES/croco.in.FORCED_DBLEEK | 172 + .../TEST_CASES/croco.in.FORCED_EKBBL | 172 + .../TEST_CASES/croco.in.FORCED_NONROTBBL | 172 + .../TEST_CASES/croco.in.FORCED_OSCNONROTBBL | 172 + .../croco-v1.3.1/TEST_CASES/croco.in.Grav_adj | 53 + .../TEST_CASES/croco.in.Grav_adj_nbq | 56 + CROCO/croco-v1.3.1/TEST_CASES/croco.in.IGW | 66 + .../croco-v1.3.1/TEST_CASES/croco.in.IGW_nbq | 67 + .../TEST_CASES/croco.in.Innershelf | 80 + .../croco-v1.3.1/TEST_CASES/croco.in.Internal | 39 + .../croco-v1.3.1/TEST_CASES/croco.in.Isoliton | 56 + CROCO/croco-v1.3.1/TEST_CASES/croco.in.Jet | 58 + .../TEST_CASES/croco.in.KATO_PHILLIPS | 172 + .../croco-v1.3.1/TEST_CASES/croco.in.KH_INST | 51 + CROCO/croco-v1.3.1/TEST_CASES/croco.in.MovBat | 41 + .../croco-v1.3.1/TEST_CASES/croco.in.Overflow | 52 + CROCO/croco-v1.3.1/TEST_CASES/croco.in.Rip | 90 + .../TEST_CASES/croco.in.Rip_tides | 90 + CROCO/croco-v1.3.1/TEST_CASES/croco.in.River | 66 + .../croco-v1.3.1/TEST_CASES/croco.in.Sandbar | 110 + .../TEST_CASES/croco.in.Sandbar_1B | 110 + .../TEST_CASES/croco.in.Sandbar_1B_nbq | 114 + .../TEST_CASES/croco.in.Sandbar_1C | 110 + .../TEST_CASES/croco.in.Sandbar_1C_nbq | 123 + .../TEST_CASES/croco.in.Sandbar_nbq | 113 + .../croco-v1.3.1/TEST_CASES/croco.in.Seamount | 47 + .../TEST_CASES/croco.in.Sed_toy_consolid | 71 + .../TEST_CASES/croco.in.Sed_toy_floc_0d | 66 + .../TEST_CASES/croco.in.Sed_toy_floc_1d | 66 + .../TEST_CASES/croco.in.Sed_toy_resusp | 71 + .../TEST_CASES/croco.in.Sed_toy_rouse | 66 + .../TEST_CASES/croco.in.Shelfront | 45 + .../TEST_CASES/croco.in.ShoreFace | 99 + .../croco-v1.3.1/TEST_CASES/croco.in.Soliton | 37 + CROCO/croco-v1.3.1/TEST_CASES/croco.in.Swash | 57 + .../TEST_CASES/croco.in.TS_adv_body | 60 + .../TEST_CASES/croco.in.TS_adv_diag | 60 + .../TEST_CASES/croco.in.TS_adv_rep | 59 + CROCO/croco-v1.3.1/TEST_CASES/croco.in.Tank | 41 + .../croco-v1.3.1/TEST_CASES/croco.in.Thacker | 33 + .../TEST_CASES/croco.in.Tidal_flat | 65 + .../TEST_CASES/croco.in.Upwelling | 44 + .../croco-v1.3.1/TEST_CASES/croco.in.VILAINE | 120 + CROCO/croco-v1.3.1/TEST_CASES/croco.in.Vortex | 61 + .../croco-v1.3.1/TEST_CASES/croco.in.Vortex.1 | 61 + .../TEST_CASES/croco.in.WILLIS_DEARDORFF | 172 + CROCO/croco-v1.3.1/TEST_CASES/floats.in.River | 10 + CROCO/croco-v1.3.1/TEST_CASES/igw_frc.nc | Bin 0 -> 3580284 bytes CROCO/croco-v1.3.1/TEST_CASES/igw_grd.nc | Bin 0 -> 954624 bytes CROCO/croco-v1.3.1/TEST_CASES/make_clim_IGW.m | 132 + CROCO/croco-v1.3.1/TEST_CASES/make_grid_IGW.m | 218 + CROCO/croco-v1.3.1/TEST_CASES/make_jet.m | 444 + CROCO/croco-v1.3.1/TEST_CASES/make_rip.m | 320 + .../croco-v1.3.1/TEST_CASES/make_tides_IGW.m | 149 + CROCO/croco-v1.3.1/TEST_CASES/make_vortex.m | 371 + CROCO/croco-v1.3.1/TEST_CASES/plot_IGW.m | 204 + CROCO/croco-v1.3.1/TEST_CASES/plot_MovBat.m | 161 + CROCO/croco-v1.3.1/TEST_CASES/plot_ana_dune.m | 183 + CROCO/croco-v1.3.1/TEST_CASES/plot_basin.m | 90 + CROCO/croco-v1.3.1/TEST_CASES/plot_canyon.m | 88 + CROCO/croco-v1.3.1/TEST_CASES/plot_dune.m | 154 + CROCO/croco-v1.3.1/TEST_CASES/plot_dune3d.m | 116 + CROCO/croco-v1.3.1/TEST_CASES/plot_equator.m | 129 + CROCO/croco-v1.3.1/TEST_CASES/plot_grav_adj.m | 115 + .../croco-v1.3.1/TEST_CASES/plot_innershelf.m | 341 + CROCO/croco-v1.3.1/TEST_CASES/plot_internal.m | 92 + CROCO/croco-v1.3.1/TEST_CASES/plot_isoliton.m | 94 + CROCO/croco-v1.3.1/TEST_CASES/plot_jet.m | 209 + CROCO/croco-v1.3.1/TEST_CASES/plot_kh_inst.m | 143 + CROCO/croco-v1.3.1/TEST_CASES/plot_overflow.m | 79 + CROCO/croco-v1.3.1/TEST_CASES/plot_rip.m | 160 + CROCO/croco-v1.3.1/TEST_CASES/plot_river.m | 129 + CROCO/croco-v1.3.1/TEST_CASES/plot_sandbar.m | 342 + .../TEST_CASES/plot_sandbar_nbq.m | 537 + CROCO/croco-v1.3.1/TEST_CASES/plot_seamount.m | 61 + .../TEST_CASES/plot_sed_toy_consolid.m | 140 + .../TEST_CASES/plot_sed_toy_resusp.m | 142 + .../TEST_CASES/plot_sed_toy_rouse.m | 155 + .../croco-v1.3.1/TEST_CASES/plot_shelfront.m | 60 + .../croco-v1.3.1/TEST_CASES/plot_shoreface.m | 331 + CROCO/croco-v1.3.1/TEST_CASES/plot_soliton.m | 101 + CROCO/croco-v1.3.1/TEST_CASES/plot_stations.m | 31 + CROCO/croco-v1.3.1/TEST_CASES/plot_swash.m | 174 + CROCO/croco-v1.3.1/TEST_CASES/plot_tank.m | 323 + CROCO/croco-v1.3.1/TEST_CASES/plot_thacker.m | 292 + .../croco-v1.3.1/TEST_CASES/plot_tidal_flat.m | 101 + .../croco-v1.3.1/TEST_CASES/plot_upwelling.m | 67 + CROCO/croco-v1.3.1/TEST_CASES/plot_vortex.m | 180 + .../TEST_CASES/sediment_ana_dune.in | 90 + .../croco-v1.3.1/TEST_CASES/sediment_dune.in | 91 + .../TEST_CASES/sediment_sandbar.in | 90 + .../TEST_CASES/sediment_sandbar_1B.in | 90 + .../TEST_CASES/sediment_sandbar_1B_nbq.in | 89 + .../TEST_CASES/sediment_sandbar_1C.in | 90 + .../TEST_CASES/sediment_sandbar_1C_nbq.in | 90 + .../TEST_CASES/sediment_sed_toy_consolid.in | 144 + .../TEST_CASES/sediment_sed_toy_floc_0d.in | 226 + .../TEST_CASES/sediment_sed_toy_floc_1d.in | 226 + .../TEST_CASES/sediment_sed_toy_resusp.in | 144 + .../TEST_CASES/sediment_sed_toy_rouse.in | 179 + .../TEST_CASES/shoreface_JW_frc.nc | Bin 0 -> 18800 bytes CROCO/croco-v1.3.1/XIOS/README_XIOS | 55 + CROCO/croco-v1.3.1/XIOS/context_croco.xml | 86 + CROCO/croco-v1.3.1/XIOS/context_wrf.xml | 39 + CROCO/croco-v1.3.1/XIOS/domain_def_croco.xml | 43 + .../XIOS/field_def_croco.xml_full_withcpp | 557 + .../XIOS/file_def_croco.xml_full_withcpp | 349 + CROCO/croco-v1.3.1/XIOS/file_def_wrf.xml | 124 + .../XIOS/iodef.xml_croco_noxios_wrf_xios | 35 + CROCO/croco-v1.3.1/XIOS/iodef.xml_croco_xios | 40 + .../XIOS/iodef.xml_croco_xios_wrf_noxios | 35 + .../XIOS/iodef.xml_croco_xios_wrf_xios | 36 + CROCO/croco-v1.3.1/XIOS/iodef.xml_wrf_xios | 33 + CROCO/croco-v1.3.1/XIOS/process_xios_xml.sh | 97 + CROCO/croco-v1.3.1/XIOS/send_xios_diags.F | 3092 ++++ CROCO/croco-v1.3.1/XIOS/xios_launch.file | 8 + CROCO/croco-v1.3.1/create_config.bash | 639 + 1082 files changed, 334158 insertions(+) create mode 100644 CROCO/croco-v1.3.1/.gitattributes create mode 100644 CROCO/croco-v1.3.1/.gitignore create mode 100644 CROCO/croco-v1.3.1/.gitlab-ci.yml create mode 100644 CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modarrays.F90 create mode 100644 CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modbc.F90 create mode 100644 CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modbcfunction.F90 create mode 100644 CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modcluster.F90 create mode 100644 CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modcurgridfunctions.F90 create mode 100644 CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modgrids.F90 create mode 100644 CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modinit.F90 create mode 100644 CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modinitvars.F90 create mode 100644 CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modinterp.F90 create mode 100644 CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modinterpbasic.F90 create mode 100644 CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modlinktomodel.F90 create mode 100644 CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modmask.F90 create mode 100644 CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modmpp.F90 create mode 100644 CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modprocs.F90 create mode 100644 CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modsauv.F90 create mode 100644 CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modseq.F90 create mode 100644 CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modtypes.F90 create mode 100644 CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modupdate.F90 create mode 100644 CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modupdatebasic.F90 create mode 100644 CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modutil.F90 create mode 100644 CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modvariables.F90 create mode 100644 CROCO/croco-v1.3.1/AGRIF/LIB/DiversListe.c create mode 100644 CROCO/croco-v1.3.1/AGRIF/LIB/Makefile create mode 100644 CROCO/croco-v1.3.1/AGRIF/LIB/SubLoopCreation.c create mode 100644 CROCO/croco-v1.3.1/AGRIF/LIB/UtilAgrif.c create mode 100644 CROCO/croco-v1.3.1/AGRIF/LIB/UtilCharacter.c create mode 100644 CROCO/croco-v1.3.1/AGRIF/LIB/UtilFile.c create mode 100644 CROCO/croco-v1.3.1/AGRIF/LIB/UtilFortran.c create mode 100644 CROCO/croco-v1.3.1/AGRIF/LIB/UtilListe.c create mode 100644 CROCO/croco-v1.3.1/AGRIF/LIB/UtilNotGridDep.c create mode 100644 CROCO/croco-v1.3.1/AGRIF/LIB/WorkWithAllocatelist.c create mode 100644 CROCO/croco-v1.3.1/AGRIF/LIB/WorkWithParameterlist.c create mode 100644 CROCO/croco-v1.3.1/AGRIF/LIB/WorkWithglobliste.c create mode 100644 CROCO/croco-v1.3.1/AGRIF/LIB/WorkWithlistdatavariable.c create mode 100644 CROCO/croco-v1.3.1/AGRIF/LIB/WorkWithlistmoduleinfile.c create mode 100644 CROCO/croco-v1.3.1/AGRIF/LIB/WorkWithlistofcoupled.c create mode 100644 CROCO/croco-v1.3.1/AGRIF/LIB/WorkWithlistofmodulebysubroutine.c create mode 100644 CROCO/croco-v1.3.1/AGRIF/LIB/WorkWithlistvarindoloop.c create mode 100644 CROCO/croco-v1.3.1/AGRIF/LIB/WorkWithvarofsubroutineliste.c create mode 100644 CROCO/croco-v1.3.1/AGRIF/LIB/WriteInFile.c create mode 100644 CROCO/croco-v1.3.1/AGRIF/LIB/Writedeclarations.c create mode 100644 CROCO/croco-v1.3.1/AGRIF/LIB/decl.h create mode 100644 CROCO/croco-v1.3.1/AGRIF/LIB/dependfile.c create mode 100644 CROCO/croco-v1.3.1/AGRIF/LIB/fortran.c create mode 100644 CROCO/croco-v1.3.1/AGRIF/LIB/main.c create mode 100644 CROCO/croco-v1.3.1/AGRIF/LIB/run create mode 100644 CROCO/croco-v1.3.1/AGRIF/LIB/toamr.c create mode 100644 CROCO/croco-v1.3.1/AGRIF/Makefile create mode 100644 CROCO/croco-v1.3.1/AGRIF/agrif2model.F90 create mode 100644 CROCO/croco-v1.3.1/AGRIF/doc/Doxyfile create mode 100644 CROCO/croco-v1.3.1/AGRIF/doc/calltree_f90.py create mode 100644 CROCO/croco-v1.3.1/CHANGELOG.md create mode 100644 CROCO/croco-v1.3.1/CVTK/common/CONFIGURE_GLOBAL create mode 100644 CROCO/croco-v1.3.1/CVTK/common/CONFIGURE_GLOBAL_PERFRST create mode 100644 CROCO/croco-v1.3.1/CVTK/common/TEST_CASES_CVTK/AGRIF_FixedGrids.in.VORTEX create mode 100644 CROCO/croco-v1.3.1/CVTK/common/TEST_CASES_CVTK/VHR/README.txt create mode 100644 CROCO/croco-v1.3.1/CVTK/common/TEST_CASES_CVTK/barocjet.m create mode 100644 CROCO/croco-v1.3.1/CVTK/common/TEST_CASES_CVTK/barocvortex.m create mode 100644 CROCO/croco-v1.3.1/CVTK/common/TEST_CASES_CVTK/floats.in.River create mode 100644 CROCO/croco-v1.3.1/CVTK/common/TEST_CASES_CVTK/igw_frc.nc create mode 100644 CROCO/croco-v1.3.1/CVTK/common/TEST_CASES_CVTK/igw_grd.nc create mode 100644 CROCO/croco-v1.3.1/CVTK/common/TEST_CASES_CVTK/make_clim_IGW.m create mode 100644 CROCO/croco-v1.3.1/CVTK/common/TEST_CASES_CVTK/make_grid_IGW.m create mode 100644 CROCO/croco-v1.3.1/CVTK/common/TEST_CASES_CVTK/make_jet.m create mode 100644 CROCO/croco-v1.3.1/CVTK/common/TEST_CASES_CVTK/make_rip.m create mode 100644 CROCO/croco-v1.3.1/CVTK/common/TEST_CASES_CVTK/make_tides_IGW.m create mode 100644 CROCO/croco-v1.3.1/CVTK/common/TEST_CASES_CVTK/make_vortex.m create mode 100644 CROCO/croco-v1.3.1/CVTK/common/TEST_CASES_CVTK/sediment_flume.in create mode 100644 CROCO/croco-v1.3.1/CVTK/common/TEST_CASES_CVTK/shoreface_JW_frc.nc create mode 100644 CROCO/croco-v1.3.1/CVTK/common/TEST_CASES_CVTK/vortex_clm.nc create mode 100644 CROCO/croco-v1.3.1/CVTK/common/TEST_CASES_CVTK/vortex_clm.nc.1 create mode 100644 CROCO/croco-v1.3.1/CVTK/common/TEST_CASES_CVTK/vortex_grd.nc create mode 100644 CROCO/croco-v1.3.1/CVTK/common/TEST_CASES_CVTK/vortex_grd.nc.1 create mode 100644 CROCO/croco-v1.3.1/CVTK/common/TEST_CASES_CVTK/vortex_his.nc create mode 100644 CROCO/croco-v1.3.1/CVTK/common/TEST_CASES_CVTK/vortex_his.nc.1 create mode 100644 CROCO/croco-v1.3.1/CVTK/common/TEST_CASES_CVTK/vortex_ini.nc create mode 100644 CROCO/croco-v1.3.1/CVTK/common/TEST_CASES_CVTK/vortex_ini.nc.1 create mode 100644 CROCO/croco-v1.3.1/CVTK/common/cleanup_all.bash create mode 100644 CROCO/croco-v1.3.1/CVTK/common/git_process.bash create mode 100644 CROCO/croco-v1.3.1/CVTK/common/gitinfo.sh create mode 100644 CROCO/croco-v1.3.1/CVTK/common/jobcomp_rvtk.bash create mode 100644 CROCO/croco-v1.3.1/CVTK/common/mk_CHECKALL.bash create mode 100644 CROCO/croco-v1.3.1/CVTK/common/mk_CLEANALL.bash create mode 100644 CROCO/croco-v1.3.1/CVTK/common/print/fancy_almost.txt create mode 100644 CROCO/croco-v1.3.1/CVTK/common/print/fancy_critical.txt create mode 100644 CROCO/croco-v1.3.1/CVTK/common/print/fancy_failure.txt create mode 100644 CROCO/croco-v1.3.1/CVTK/common/print/fancy_sucess.txt create mode 100644 CROCO/croco-v1.3.1/CVTK/test_perfrst/CONFIGURE_REG_PERFRST create mode 100644 CROCO/croco-v1.3.1/CVTK/test_perfrst/Scripts_reg_perfrst/Configure_Test_reg_ALL_perfrst/AGRIF1W create mode 100644 CROCO/croco-v1.3.1/CVTK/test_perfrst/Scripts_reg_perfrst/Configure_Test_reg_ALL_perfrst/AGRIF2W create mode 100644 CROCO/croco-v1.3.1/CVTK/test_perfrst/Scripts_reg_perfrst/Configure_Test_reg_ALL_perfrst/BRY create mode 100644 CROCO/croco-v1.3.1/CVTK/test_perfrst/Scripts_reg_perfrst/Configure_Test_reg_ALL_perfrst/BSTRESS_FAST create mode 100644 CROCO/croco-v1.3.1/CVTK/test_perfrst/Scripts_reg_perfrst/Configure_Test_reg_ALL_perfrst/BULK create mode 100644 CROCO/croco-v1.3.1/CVTK/test_perfrst/Scripts_reg_perfrst/Configure_Test_reg_ALL_perfrst/CFB create mode 100644 CROCO/croco-v1.3.1/CVTK/test_perfrst/Scripts_reg_perfrst/Configure_Test_reg_ALL_perfrst/CFBBULK create mode 100644 CROCO/croco-v1.3.1/CVTK/test_perfrst/Scripts_reg_perfrst/Configure_Test_reg_ALL_perfrst/CFBBULKONLINE create mode 100644 CROCO/croco-v1.3.1/CVTK/test_perfrst/Scripts_reg_perfrst/Configure_Test_reg_ALL_perfrst/CLIM create mode 100644 CROCO/croco-v1.3.1/CVTK/test_perfrst/Scripts_reg_perfrst/Configure_Test_reg_ALL_perfrst/GLS create mode 100644 CROCO/croco-v1.3.1/CVTK/test_perfrst/Scripts_reg_perfrst/Configure_Test_reg_ALL_perfrst/PISCES create mode 100644 CROCO/croco-v1.3.1/CVTK/test_perfrst/Scripts_reg_perfrst/Configure_Test_reg_ALL_perfrst/TIDES create mode 100644 CROCO/croco-v1.3.1/CVTK/test_perfrst/Scripts_reg_perfrst/Configure_Test_reg_perfrst/BRY create mode 100644 CROCO/croco-v1.3.1/CVTK/test_perfrst/Scripts_reg_perfrst/Configure_Test_reg_perfrst/BSTRESS_FAST create mode 100644 CROCO/croco-v1.3.1/CVTK/test_perfrst/Scripts_reg_perfrst/Configure_Test_reg_perfrst/BULK create mode 100644 CROCO/croco-v1.3.1/CVTK/test_perfrst/Scripts_reg_perfrst/Configure_Test_reg_perfrst/CFB create mode 100644 CROCO/croco-v1.3.1/CVTK/test_perfrst/Scripts_reg_perfrst/Configure_Test_reg_perfrst/CFBBULK create mode 100644 CROCO/croco-v1.3.1/CVTK/test_perfrst/Scripts_reg_perfrst/Configure_Test_reg_perfrst/CFBBULKONLINE create mode 100644 CROCO/croco-v1.3.1/CVTK/test_perfrst/Scripts_reg_perfrst/Configure_Test_reg_perfrst/CLIM create mode 100644 CROCO/croco-v1.3.1/CVTK/test_perfrst/Scripts_reg_perfrst/Configure_Test_reg_perfrst/GLS create mode 100644 CROCO/croco-v1.3.1/CVTK/test_perfrst/Scripts_reg_perfrst/Configure_Test_reg_perfrst/TIDES create mode 100644 CROCO/croco-v1.3.1/CVTK/test_perfrst/Scripts_reg_perfrst/create_link_for_Test_reg_perfrst.sh create mode 100644 CROCO/croco-v1.3.1/CVTK/test_perfrst/Scripts_reg_perfrst/create_link_master_reg_perfrst.sh create mode 100644 CROCO/croco-v1.3.1/CVTK/test_perfrst/comp_run_mpi_perfrst.bash create mode 100644 CROCO/croco-v1.3.1/CVTK/test_perfrst/extract_results_croco_perfrst.bash create mode 100644 CROCO/croco-v1.3.1/CVTK/test_perfrst/gather_recap_perfrst.bash create mode 100644 CROCO/croco-v1.3.1/CVTK/test_perfrst/mk_TESTALL_perfrst.bash create mode 100644 CROCO/croco-v1.3.1/CVTK/test_perfrst/mk_TestDIR_perfrst.bash create mode 100644 CROCO/croco-v1.3.1/CVTK/test_perfrst/rvtk_fast_qsub_perfrst.bash create mode 100644 CROCO/croco-v1.3.1/CVTK/test_perfrst/test_croco_perfrst.sh create mode 100644 CROCO/croco-v1.3.1/CVTK/test_real/README.txt create mode 100644 CROCO/croco-v1.3.1/CVTK/test_real/clean.sh create mode 100644 CROCO/croco-v1.3.1/CVTK/test_real/diff_real.sh create mode 100644 CROCO/croco-v1.3.1/CVTK/test_real/plot_real.sh create mode 100644 CROCO/croco-v1.3.1/CVTK/test_real/run_real.sh create mode 100644 CROCO/croco-v1.3.1/CVTK/test_real/send_real.sh create mode 100644 CROCO/croco-v1.3.1/CVTK/test_real/test_real.sh create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/CONFIGURE_ANA create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/CONFIGURE_REG create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/CONFIGURE_VORT create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana/BASIN create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana/CANYON create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana/DUNE create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana/EQUATOR create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana/ESTUARY create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana/GRAV_ADJ create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana/IGW create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana/INNERSHELF create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana/INTERNAL create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana/ISOLITON create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana/JET create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana/KH_INST create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana/OVERFLOW create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana/RIP create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana/RIVER create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana/SANDBAR create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana/SEAMOUNT create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana/SHELFRONT create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana/SHOREFACE create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana/SWASH create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana/TANK create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana/THACKER create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana/TIDAL_FLAT create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana/TS_HADV_TEST create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana/UPWELLING create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana_ALL/BASIN create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana_ALL/CANYON create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana_ALL/DUNE create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana_ALL/EQUATOR create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana_ALL/GRAV_ADJ create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana_ALL/IGW create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana_ALL/INNERSHELF create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana_ALL/INTERNAL create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana_ALL/ISOLITON create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana_ALL/JET create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana_ALL/KH_INST create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana_ALL/OVERFLOW create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana_ALL/RIP create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana_ALL/RIVER create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana_ALL/SANDBAR create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana_ALL/SEAMOUNT create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana_ALL/SHELFRONT create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana_ALL/SHOREFACE create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana_ALL/SWASH create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana_ALL/TANK create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana_ALL/THACKER create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana_ALL/TIDAL_FLAT create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana_ALL/TS_HADV_TEST create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/Configure_Test_ana_ALL/UPWELLING create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/create_link_for_Test_ana.sh create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_ana/create_link_master_ana.sh create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg/AGRIF1W22 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg/AGRIF2W22 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg/BRY14 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg/BRY22 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg/BRY41 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg/BRYPISCES22 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg/BSTRESS_FASTGLS22 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg/BSTRESS_FASTKPP22 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg/BULK22 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg/BULKONLINE22 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg/CFB22 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg/CFBBULK22 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg/CFBBULKONLINE22 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg/CLIM14 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg/CLIM22 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg/CLIM41 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg/GLS22 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg/TIDES22 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg_ALL/AGRIF1W22 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg_ALL/AGRIF2W22 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg_ALL/BRY14 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg_ALL/BRY22 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg_ALL/BRY41 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg_ALL/BRYPISCES22 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg_ALL/BRYPISCESAGRIF22 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg_ALL/BSTRESS_FASTGLS22 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg_ALL/BSTRESS_FASTKPP22 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg_ALL/BULK22 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg_ALL/BULKONLINE22 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg_ALL/CFB22 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg_ALL/CFBBULK22 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg_ALL/CFBBULKONLINE22 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg_ALL/CLIM14 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg_ALL/CLIM22 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg_ALL/CLIM41 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg_ALL/GLS22 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/Configure_Test_reg_ALL/TIDES22 create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/create_link_for_Test_reg.sh create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_reg/create_link_master_reg.sh create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_vort/Configure_Test_vort/AGRIF1W create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_vort/Configure_Test_vort/AGRIF2W create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_vort/Configure_Test_vort/NoAGRIF create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_vort/create_link_for_Test_vort.sh create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/Scripts_vort/create_link_master_vort.sh create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/comp_run_mpi.bash create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/comp_run_openmp.bash create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/comp_run_serial.bash create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/doc/Doc_CVTK_FAST_v1.1_datarmor.pdf create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/extract_results_croco.bash create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/gather_recap.bash create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/mk_TESTALL.bash create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/mk_TestDIR.bash create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/rvtk_fast_qsub.bash create mode 100644 CROCO/croco-v1.3.1/CVTK/test_repro/test_croco.sh create mode 100644 CROCO/croco-v1.3.1/DOC_SPHINX/template_doc create mode 100644 CROCO/croco-v1.3.1/MPI_NOLAND/Makefile create mode 100644 CROCO/croco-v1.3.1/MPI_NOLAND/README.txt create mode 100644 CROCO/croco-v1.3.1/MPI_NOLAND/mpp_optimiz.f90 create mode 100644 CROCO/croco-v1.3.1/MPI_NOLAND/mpp_plot.py create mode 100644 CROCO/croco-v1.3.1/MPI_NOLAND/namelist create mode 100644 CROCO/croco-v1.3.1/MUSTANG/LICENSE_MUSTANG.txt create mode 100644 CROCO/croco-v1.3.1/MUSTANG/MUSTANG_NAMELIST/paraMUSTANGV1_Sed_toy.txt create mode 100644 CROCO/croco-v1.3.1/MUSTANG/MUSTANG_NAMELIST/paraMUSTANGV1_Sed_toy_floc_0d.txt create mode 100644 CROCO/croco-v1.3.1/MUSTANG/MUSTANG_NAMELIST/paraMUSTANGV1_Sed_toy_floc_1d.txt create mode 100644 CROCO/croco-v1.3.1/MUSTANG/MUSTANG_NAMELIST/paraMUSTANGV1_Tidal_flat.txt create mode 100644 CROCO/croco-v1.3.1/MUSTANG/MUSTANG_NAMELIST/paraMUSTANGV1_estuary.txt create mode 100644 CROCO/croco-v1.3.1/MUSTANG/MUSTANG_NAMELIST/paraMUSTANGV1_vilaine.txt create mode 100644 CROCO/croco-v1.3.1/MUSTANG/MUSTANG_NAMELIST/paraMUSTANGV2_Ana_dune.txt create mode 100644 CROCO/croco-v1.3.1/MUSTANG/MUSTANG_NAMELIST/paraMUSTANGV2_Dune.txt create mode 100644 CROCO/croco-v1.3.1/MUSTANG/MUSTANG_NAMELIST/paraMUSTANG_default.txt create mode 100644 CROCO/croco-v1.3.1/MUSTANG/MUSTANG_NAMELIST/parasubstance_MUSTANG_Ana_dune.txt create mode 100644 CROCO/croco-v1.3.1/MUSTANG/MUSTANG_NAMELIST/parasubstance_MUSTANG_Dune.txt create mode 100644 CROCO/croco-v1.3.1/MUSTANG/MUSTANG_NAMELIST/parasubstance_MUSTANG_Sed_toy.txt create mode 100644 CROCO/croco-v1.3.1/MUSTANG/MUSTANG_NAMELIST/parasubstance_MUSTANG_Sed_toy_floc_0d.txt create mode 100644 CROCO/croco-v1.3.1/MUSTANG/MUSTANG_NAMELIST/parasubstance_MUSTANG_Sed_toy_floc_1d.txt create mode 100644 CROCO/croco-v1.3.1/MUSTANG/MUSTANG_NAMELIST/parasubstance_MUSTANG_Tidal_flat.txt create mode 100644 CROCO/croco-v1.3.1/MUSTANG/MUSTANG_NAMELIST/parasubstance_MUSTANG_estuary.txt create mode 100644 CROCO/croco-v1.3.1/MUSTANG/MUSTANG_NAMELIST/parasubstance_MUSTANG_full_example.txt create mode 100644 CROCO/croco-v1.3.1/MUSTANG/MUSTANG_NAMELIST/parasubstance_MUSTANG_vilaine.txt create mode 100644 CROCO/croco-v1.3.1/MUSTANG/comMUSTANG.F90 create mode 100644 CROCO/croco-v1.3.1/MUSTANG/comsubstance.F90 create mode 100644 CROCO/croco-v1.3.1/MUSTANG/coupler_MUSTANG.F90 create mode 100644 CROCO/croco-v1.3.1/MUSTANG/coupler_define_MUSTANG.h create mode 100644 CROCO/croco-v1.3.1/MUSTANG/flocmod.F90 create mode 100644 CROCO/croco-v1.3.1/MUSTANG/initMUSTANG.F90 create mode 100644 CROCO/croco-v1.3.1/MUSTANG/module_MUSTANG.F create mode 100644 CROCO/croco-v1.3.1/MUSTANG/module_substance.F create mode 100644 CROCO/croco-v1.3.1/MUSTANG/plug_MUSTANG_CROCO.F90 create mode 100644 CROCO/croco-v1.3.1/MUSTANG/sed_MUSTANG.F90 create mode 100644 CROCO/croco-v1.3.1/MUSTANG/sed_MUSTANG_CROCO.F90 create mode 100644 CROCO/croco-v1.3.1/MUSTANG/substance.F90 create mode 100644 CROCO/croco-v1.3.1/MUSTANG/t3dmix_tridiagonal_settling.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/AGRIF_FixedGrids.in create mode 100644 CROCO/croco-v1.3.1/OCEAN/Agrif2Model.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/FCT.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/MPI_Setup.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/Makedefs.generic create mode 100644 CROCO/croco-v1.3.1/OCEAN/Makedefs.generic.AGRIF create mode 100644 CROCO/croco-v1.3.1/OCEAN/Makefile create mode 100644 CROCO/croco-v1.3.1/OCEAN/MessPass2D.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/MessPass3D.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/ab_ratio.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/agrif_ext.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/alfabeta.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/alfabeta_k.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/amr.in create mode 100644 CROCO/croco-v1.3.1/OCEAN/ana_grid.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/ana_initial.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/ana_vmix.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/analytical.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/autotiling.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/autotiling.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/averages.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/bbl.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/bbl.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/bio_BioEBUS.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/bio_N2ChlPZD2.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/bio_NChlPZD.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/bio_diag.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/biology.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/boundary.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/buffer.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/bulk_flux.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/bvf_mix.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/check_kwds.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/check_switches2.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/checkdims.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/checkkwds.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/climat.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/clm_tides.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/closecdf.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/compute_auxiliary_bounds.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/compute_extended_bounds.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/compute_horiz_tracer_fluxes.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/compute_message_bounds.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/compute_starts_counts.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/compute_tile_bounds.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/compute_vert_tracer_fluxes.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/coupling.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/cpl_prism_define.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/cpl_prism_get.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/cpl_prism_getvar.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/cpl_prism_grid.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/cpl_prism_init.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/cpl_prism_put.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/cppcheck.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/cppdefs.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/cppdefs_dev.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/croco.in create mode 100644 CROCO/croco-v1.3.1/OCEAN/croco.in.1 create mode 100644 CROCO/croco-v1.3.1/OCEAN/croco_forecast.in create mode 100644 CROCO/croco-v1.3.1/OCEAN/croco_hindcast.in create mode 100644 CROCO/croco-v1.3.1/OCEAN/croco_inter.in create mode 100644 CROCO/croco-v1.3.1/OCEAN/croco_inter.in.1 create mode 100644 CROCO/croco-v1.3.1/OCEAN/croco_oa.F90 create mode 100644 CROCO/croco-v1.3.1/OCEAN/croco_stations.in create mode 100644 CROCO/croco-v1.3.1/OCEAN/cross_matrix.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/cste_bio_coastal.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/debug.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/debug_indices.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/def_bio_diags.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/def_bounds.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/def_diags.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/def_diagsM.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/def_diags_eddy.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/def_diags_ek.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/def_diags_pv.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/def_diags_vrt.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/def_floats.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/def_grid_2d.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/def_grid_3d.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/def_his.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/def_rst.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/def_sta.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/def_surf.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/diag.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/diag_vars.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/diagnostics.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/diags_eddy.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/diags_ek.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/diags_pv.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/diags_vrt.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/dynderivparam.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/dynparam.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/dynparam_f77.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/exchange.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/exchange_2d_tile.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/exchange_3d_tile.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/fillvalue.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/finalize_diagnostics_tsadv.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/floats.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/floats.in create mode 100644 CROCO/croco-v1.3.1/OCEAN/floats.in.River create mode 100644 CROCO/croco-v1.3.1/OCEAN/floats.in_README create mode 100644 CROCO/croco-v1.3.1/OCEAN/forces.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/get_bry.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/get_bry_bio.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/get_bry_wkb.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/get_btflux.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/get_bulk.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/get_date.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/get_grid.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/get_initial.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/get_initial_floats.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/get_psource.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/get_psource_ts.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/get_smflux.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/get_srflux.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/get_ssh.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/get_sss.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/get_sst.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/get_stflux.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/get_tclima.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/get_tides.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/get_uclima.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/get_vbc.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/get_wwave.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/gls_mixing.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/gls_smooth.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/gls_stab_func.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/grid.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/grid_nbq.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/grid_stiffness.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/hmix_coef.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/init_arrays.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/init_arrays_floats.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/init_arrays_sta.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/init_floats.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/init_floats.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/init_scalars.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/init_sta.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/init_sta.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/initfloats.m create mode 100644 CROCO/croco-v1.3.1/OCEAN/initial_nbq.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/insert_node.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/interp_rho.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/interp_sta.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/jobcomp create mode 100644 CROCO/croco-v1.3.1/OCEAN/kpp_smooth.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/lenstr.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/lmd_bkpp.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/lmd_bkpp1994.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/lmd_bkpp2005.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/lmd_kpp.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/lmd_skpp.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/lmd_skpp1994.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/lmd_skpp2005.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/lmd_swfrac.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/lmd_vmix.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/lmd_wscale.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/lmd_wscale_wm_and_ws.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/lmd_wscale_ws_only.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/main.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/mas.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/mixing.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/mod_tides_mas.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/module_checkmpi.F90 create mode 100644 CROCO/croco-v1.3.1/OCEAN/module_grd_oa.F90 create mode 100644 CROCO/croco-v1.3.1/OCEAN/module_oa_interface.F90 create mode 100644 CROCO/croco-v1.3.1/OCEAN/module_oa_level.F90 create mode 100644 CROCO/croco-v1.3.1/OCEAN/module_oa_periode.F90 create mode 100644 CROCO/croco-v1.3.1/OCEAN/module_oa_space.F90 create mode 100644 CROCO/croco-v1.3.1/OCEAN/module_oa_time.F90 create mode 100644 CROCO/croco-v1.3.1/OCEAN/module_oa_type.F90 create mode 100644 CROCO/croco-v1.3.1/OCEAN/module_oa_variables.F90 create mode 100644 CROCO/croco-v1.3.1/OCEAN/module_ocean3d.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/module_param.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/module_parameter_oa.F90 create mode 100644 CROCO/croco-v1.3.1/OCEAN/module_qsort.F90 create mode 100644 CROCO/croco-v1.3.1/OCEAN/module_scalars.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/module_tile_oa.F90 create mode 100644 CROCO/croco-v1.3.1/OCEAN/module_tracetxt_out.F90 create mode 100644 CROCO/croco-v1.3.1/OCEAN/mpc.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/mpi_cpl.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/mrl_wci.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/nbq.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/nbq_bry_store.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/nc_sta.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/ncjoin.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/ncrename.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/ncscrum.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/ncscrum.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/ncscrum_floats.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/nf_add_attribute.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/nf_fread.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/nf_fread_x.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/nf_fread_y.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/nf_read_bry.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/o2sato.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/obc_volcons.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/ocean2d.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/ocean3d.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/omega.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/online.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/online_bulk_var.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/online_get_bulk.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/online_interp.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/online_interpolate_bulk.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/online_set_bulk.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/online_spectral_diags.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/output.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/output_oa.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/param.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/param.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/parameter.passivetrc.pisces.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/params_bulk.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/partit.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/partit.F_optim_nocompatible_bryfile create mode 100644 CROCO/croco-v1.3.1/OCEAN/pre_step3d.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/private_scratch.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/private_scratch_AMR.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/prsgrd.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/put_global_atts.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/random_walk.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/read_inp.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/rho_eos.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/rhs3d.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/rhs3d_w_nh.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/rhs_floats.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/rnbq_bc.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/scal0d_oa_out_full.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/scal0d_oa_out_loc.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/scalars.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/scalars.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/scalars_F90.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/sediment.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/sediment.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/sediment.in create mode 100644 CROCO/croco-v1.3.1/OCEAN/set_avg.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/set_bio_diags_avg.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/set_cycle.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/set_depth.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/set_diagsM_avg.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/set_diags_avg.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/set_diags_eddy_avg.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/set_diags_ek.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/set_diags_ek_avg.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/set_diags_pv.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/set_diags_pv_avg.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/set_diags_vrt.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/set_diags_vrt_avg.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/set_global_definitions.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/set_nudgcof.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/set_nudgcof_fine.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/set_obc_definitions.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/set_scoord.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/set_surf_avg.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/set_weights.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/setup_grid1.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/setup_grid2.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/sources.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/spkitlocal_nh.F90 create mode 100644 CROCO/croco-v1.3.1/OCEAN/srcscheck.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/sstskin.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/sta.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/stations.in create mode 100644 CROCO/croco-v1.3.1/OCEAN/step.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/step2d.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/step3d_fast.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/step3d_t.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/step3d_uv1.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/step3d_uv2.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/step3d_w.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/step_floats.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/step_sta.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/strings.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/surf.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/t3dadv_order5.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/t3dbc.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/t3dmix.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/t3dmix_ISO.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/t3dmix_S.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/t3dmix_spg.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/t3dmix_tridiagonal.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/t3dpremix.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/testkeys create mode 100644 CROCO/croco-v1.3.1/OCEAN/testkeys.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/tidedata.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/tides.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/timers_roms.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/tooldatetosec.F90 create mode 100644 CROCO/croco-v1.3.1/OCEAN/tooldatosec.F90 create mode 100644 CROCO/croco-v1.3.1/OCEAN/tooldecompdat.F90 create mode 100644 CROCO/croco-v1.3.1/OCEAN/toolorigindate.F90 create mode 100644 CROCO/croco-v1.3.1/OCEAN/toolsectodat.F90 create mode 100644 CROCO/croco-v1.3.1/OCEAN/tridiag_pred.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/u2dbc.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/u3dbc.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/u_hadv_order5.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/u_vadv_order5.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/uhdiff_order5.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/unbq_bc.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/update2D.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/update3D.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/uv3dmix.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/uv3dmix4_GP.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/uv3dmix4_S.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/uv3dmix_GP.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/uv3dmix_S.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/uv3dmix_spg.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/uv3dpremix.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/uvhadv_tvd.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/v2dbc.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/v3dbc.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/v_hadv_order5.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/v_vadv_order5.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/var2d_oa_out.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/var3d_oa_out.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/var_oa.F90 create mode 100644 CROCO/croco-v1.3.1/OCEAN/vhdiff_order5.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/vnbq_bc.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/w3dbc.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/w_hadv_order5.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/w_vadv_order5.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/wave_maker.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/wave_maker_internal.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/wavedry.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/wetdry.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/wkb_wwave.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/wkb_wwave.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/wkbbc.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/wnbq_bc.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/work.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/wrt_avg.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/wrt_bio_diags.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/wrt_bio_diags_avg.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/wrt_diags.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/wrt_diagsM.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/wrt_diagsM_avg.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/wrt_diags_avg.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/wrt_diags_eddy_avg.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/wrt_diags_ek.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/wrt_diags_ek_avg.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/wrt_diags_pv.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/wrt_diags_pv_avg.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/wrt_diags_vrt.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/wrt_diags_vrt_avg.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/wrt_floats.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/wrt_grid.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/wrt_his.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/wrt_rst.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/wrt_sta.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/wrt_surf.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/wrt_surf_avg.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/wvlcty.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/zetabc.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/zonavg.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/zoom.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/zoom.h create mode 100644 CROCO/croco-v1.3.1/OCEAN/zoombc_2D.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/zoombc_3D.F create mode 100644 CROCO/croco-v1.3.1/OCEAN/zoombc_3Dfast.F create mode 100644 CROCO/croco-v1.3.1/PISCES/README create mode 100644 CROCO/croco-v1.3.1/PISCES/SED/namelist_sediment_cfg create mode 100644 CROCO/croco-v1.3.1/PISCES/SED/namelist_sediment_ref create mode 100644 CROCO/croco-v1.3.1/PISCES/SED/oce_sed.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/SED/par_sed.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/SED/sed.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/SED/sed_oce.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/SED/sedadv.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/SED/sedarr.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/SED/sedbtb.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/SED/sedchem.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/SED/sedco3.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/SED/seddiff.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/SED/seddsr.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/SED/seddta.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/SED/sedini.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/SED/sedinitrc.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/SED/sedinorg.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/SED/sedmat.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/SED/sedmbc.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/SED/sedmodel.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/SED/sedorg.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/SED/sedrst.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/SED/sedsfc.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/SED/sedstp.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/SED/sedwri.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/SED/setavg_sed.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/biology_pisces.F create mode 100644 CROCO/croco-v1.3.1/PISCES/biology_pisces.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/kRGB61.txt create mode 100644 CROCO/croco-v1.3.1/PISCES/kRGB61.txt.1 create mode 100644 CROCO/croco-v1.3.1/PISCES/namelist_pisces_cfg create mode 100644 CROCO/croco-v1.3.1/PISCES/namelist_pisces_cfg.1 create mode 100644 CROCO/croco-v1.3.1/PISCES/namelist_pisces_ref create mode 100644 CROCO/croco-v1.3.1/PISCES/namelist_pisces_ref.1 create mode 100644 CROCO/croco-v1.3.1/PISCES/ocean2pisces.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/ocean2pisces.h90 create mode 100644 CROCO/croco-v1.3.1/PISCES/p4zagg.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/p4zbio.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/p4zche.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/p4zfechem.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/p4zflx.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/p4zint.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/p4zligand.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/p4zlim.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/p4zlys.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/p4zmeso.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/p4zmicro.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/p4zmort.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/p4zopt.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/p4zpoc.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/p4zprod.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/p4zrem.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/p4zsbc.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/p4zsed.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/p4zsink.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/p4zsms.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/p5zlim.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/p5zmeso.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/p5zmicro.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/p5zmort.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/p5zprod.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/par_pisces.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/pisces_ini.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/sms_pisces.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/top_substitute.h90 create mode 100644 CROCO/croco-v1.3.1/PISCES/trc.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/trcini_pisces.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/trcsms_pisces.F90 create mode 100644 CROCO/croco-v1.3.1/PISCES/trcwri_pisces.F90 create mode 100644 CROCO/croco-v1.3.1/README.md create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/NAMELIST_OANALYSIS/namelist_Wavelet_M2_oa create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/NAMELIST_OANALYSIS/namelist_Wavelet_M4_oa create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/NAMELIST_OANALYSIS/namelist_kc_morlet_oa create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/NAMELIST_OANALYSIS/namelist_marnage_morlet_oa create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/NAMELIST_OANALYSIS/namelist_marnage_moyenne_oa create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/NAMELIST_OANALYSIS/namelist_oa create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/NAMELIST_OANALYSIS/namelist_oa.marnage create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/NAMELIST_OANALYSIS/namelist_oa.u create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/NAMELIST_OANALYSIS/namelist_oa.u.marnage create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/NAMELIST_OANALYSIS/namelist_oa_2 create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/NAMELIST_OANALYSIS/namelist_test_dirac_oa create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/NAMELIST_OANALYSIS/namelist_test_morlet_oa create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/NAMELIST_OANALYSIS/namelist_u_dirac_oa create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/NAMELIST_OANALYSIS/namelist_u_morlet_oa create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/NAMELIST_OANALYSIS/namelist_w_dirac_oa create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/Plurimonths_scripts/run_croco.bash create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/Plurimonths_scripts/run_croco_forecast.bash create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/Plurimonths_scripts/run_croco_inter.bash create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/CROCO_IN/croco.in.base create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/OASIS_IN/make.ADA create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/OASIS_IN/make.DATARMOR create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/OASIS_IN/namcouple.base.1o2a create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/OASIS_IN/namcouple.base.2o1a create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/OASIS_IN/namcouple.base.2o2a create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/OASIS_IN/namcouple.base.aw create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/OASIS_IN/namcouple.base.aw.debug create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/OASIS_IN/namcouple.base.aw.nointerp create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/OASIS_IN/namcouple.base.aw.toyatm create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/OASIS_IN/namcouple.base.aw.toywav create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/OASIS_IN/namcouple.base.oa create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/OASIS_IN/namcouple.base.oa.smtha2o create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/OASIS_IN/namcouple.base.oa.smtho2a create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/OASIS_IN/namcouple.base.oa.smtho2a.smtha2o create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/OASIS_IN/namcouple.base.oa.toyatm create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/OASIS_IN/namcouple.base.oa.toyatm.Add_psfc create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/OASIS_IN/namcouple.base.oa.toyoce create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/OASIS_IN/namcouple.base.ow create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/OASIS_IN/namcouple.base.ow.toyoce create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/OASIS_IN/namcouple.base.ow.toywav create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/OASIS_IN/namcouple.base.owa create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/OASIS_IN/namcouple.base.owa.instfield create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/OASIS_IN/namcouple.base.owa.toyatm create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/OASIS_IN/namcouple.base.owa.toyatm.toyoce create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/OASIS_IN/namcouple.base.owa.toyatm.toywav create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/OASIS_IN/namcouple.base.owa.toyoce create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/OASIS_IN/namcouple.base.owa.toywav create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/OASIS_IN/namcouple.base.owa.toywav.toyoce create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/README_coupling_tools create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/MACHINE/DATARMOR/header.DATARMOR create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/MACHINE/DATARMOR/launch_DATARMOR.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/MACHINE/DATARMOR/myenv.DATARMOR create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/MACHINE/DATARMOR/myenv.DATARMOR.wrf create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/MACHINE/DATARMOR/myenv.DATARMOR.ww3 create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/MACHINE/IRENE/header.IRENE create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/MACHINE/IRENE/launch_IRENE.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/MACHINE/IRENE/myenv.IRENE create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/MACHINE/IRENE/myenv.IRENE.wrf create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/MACHINE/IRENE/myenv.IRENE.ww3 create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/MACHINE/JEANZAY/header.JEANZAY create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/MACHINE/JEANZAY/launch_JEANZAY.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/MACHINE/JEANZAY/myenv.JEANZAY create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/MACHINE/JEANZAY/myenv.JEANZAY.wrf create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/MACHINE/JEANZAY/myenv.JEANZAY.ww3 create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/MACHINE/LEFTRARU/header.LEFTRARU create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/MACHINE/LEFTRARU/launch_LEFTRARU.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/MACHINE/LEFTRARU/myenv.LEFTRARU create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/MACHINE/LEFTRARU/myenv.LEFTRARU.wrf create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/MACHINE/LEFTRARU/myenv.LEFTRARU.ww3 create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/MACHINE/Linux/header.Linux create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/MACHINE/Linux/launch_Linux.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/MACHINE/Linux/myenv.Linux create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/MACHINE/Linux/myenv.Linux.wrf create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/MACHINE/Linux/myenv.Linux.ww3 create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/NAMELISTS/mynamelist_full.sh_example create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/NAMELISTS/namelist_atm.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/NAMELISTS/namelist_cpl.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/NAMELISTS/namelist_head.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/NAMELISTS/namelist_head_toy.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/NAMELISTS/namelist_oce.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/NAMELISTS/namelist_rundir.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/NAMELISTS/namelist_tail.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/NAMELISTS/namelist_toy.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/NAMELISTS/namelist_wav.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/NAMELISTS/namelist_xios.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/OASIS_SCRIPTS/create_oasis_grids_for_wrf.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/OASIS_SCRIPTS/create_oasis_restart_from_calm_conditions.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/OASIS_SCRIPTS/create_oasis_restart_from_preexisting_output_files.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/OASIS_SCRIPTS/create_oasis_toy_files.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/OASIS_SCRIPTS/from_croco.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/OASIS_SCRIPTS/from_wrf.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/OASIS_SCRIPTS/from_ww3.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/OASIS_SCRIPTS/mpmdconf_create.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/OASIS_SCRIPTS/to_wrf_stag_grid.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/PATHS/path_atm.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/PATHS/path_base.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/PATHS/path_cpl.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/PATHS/path_oce.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/PATHS/path_toy.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/PATHS/path_wav.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/PATHS/path_xios.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/atm_getfile.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/atm_getrst.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/atm_nam.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/atm_putfile.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/caldat.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/caltools.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/chained_job.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/common_definitions.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/common_printing.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/cpl_getfile.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/cpl_getrst.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/cpl_nam.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/cpl_putfile.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/getversion.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/job.base.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/julday.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/oce_compile.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/oce_getbdy.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/oce_getfile.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/oce_getfrc.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/oce_getrst.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/oce_nam.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/oce_putfile.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/toy_getfile.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/toy_nam.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/wav_getfile.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/wav_getrst.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/wav_putfile.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/SCRIPTS_TOOLBOX/xios_process.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/TOY_IN/Makefile create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/TOY_IN/Makefile.ADA create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/TOY_IN/Makefile.DATARMOR create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/TOY_IN/Makefile.IRENE create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/TOY_IN/Makefile.JEANZAY create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/TOY_IN/Makefile.LEFTRARU create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/TOY_IN/TOYNAMELIST.nam.atm.aw create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/TOY_IN/TOYNAMELIST.nam.atm.oa create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/TOY_IN/TOYNAMELIST.nam.atm.oa.Add_psfc create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/TOY_IN/TOYNAMELIST.nam.atm.owa create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/TOY_IN/TOYNAMELIST.nam.oce.oa create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/TOY_IN/TOYNAMELIST.nam.oce.ow create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/TOY_IN/TOYNAMELIST.nam.oce.ow.bck create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/TOY_IN/TOYNAMELIST.nam.oce.owa create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/TOY_IN/TOYNAMELIST.nam.wav.aw create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/TOY_IN/TOYNAMELIST.nam.wav.ow create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/TOY_IN/TOYNAMELIST.nam.wav.ow.bck create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/TOY_IN/TOYNAMELIST.nam.wav.owa create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/TOY_IN/TWOTOYNAMELIST.nam.atm.owa create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/TOY_IN/TWOTOYNAMELIST.nam.oce.owa create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/TOY_IN/TWOTOYNAMELIST.nam.wav.owa create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/TOY_IN/compile_toy.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/TOY_IN/decomp_def.F90 create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/TOY_IN/function_sent.F90 create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/TOY_IN/read_dimgrid.F90 create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/TOY_IN/read_forcing.F90 create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/TOY_IN/read_grid.F90 create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/TOY_IN/read_namelist.F90 create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/TOY_IN/readme create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/TOY_IN/routine_hdlerr.F90 create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/TOY_IN/toy_model.F90 create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/ADA.compile.wrf.ll create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/CONFIGURE_WRF/DATARMOR/configure.wrf.coupled create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/CONFIGURE_WRF/DATARMOR/configure.wrf.coupled_movingnest create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/CONFIGURE_WRF/DATARMOR/configure.wrf.coupled_movingnest_terrain_landuse create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/CONFIGURE_WRF/DATARMOR/configure.wrf.coupled_xios create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/CONFIGURE_WRF/DATARMOR/configure.wrf.uncoupled create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/CONFIGURE_WRF/DATARMOR/configure.wrf.uncoupled_movingnest create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/CONFIGURE_WRF/DATARMOR/configure.wrf.uncoupled_movingnest_terrain_landuse create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/CONFIGURE_WRF/DATARMOR/configure.wrf.uncoupled_xios create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/CONFIGURE_WRF/IRENE/configure.wrf.coupled create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/CONFIGURE_WRF/IRENE/configure.wrf.coupled_movingnest create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/CONFIGURE_WRF/IRENE/configure.wrf.coupled_movingnest_terrain_landuse create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/CONFIGURE_WRF/IRENE/configure.wrf.coupled_xios create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/CONFIGURE_WRF/IRENE/configure.wrf.uncoupled create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/CONFIGURE_WRF/IRENE/configure.wrf.uncoupled_movingnest create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/CONFIGURE_WRF/IRENE/configure.wrf.uncoupled_movingnest_terrain_landuse create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/CONFIGURE_WRF/IRENE/configure.wrf.uncoupled_xios create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/CONFIGURE_WRF/JEANZAY/configure.wrf.coupled create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/CONFIGURE_WRF/JEANZAY/configure.wrf.coupled_movingnest create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/CONFIGURE_WRF/JEANZAY/configure.wrf.coupled_movingnest_terrain_landuse create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/CONFIGURE_WRF/JEANZAY/configure.wrf.coupled_xios create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/CONFIGURE_WRF/JEANZAY/configure.wrf.uncoupled create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/CONFIGURE_WRF/JEANZAY/configure.wrf.uncoupled_movingnest create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/CONFIGURE_WRF/JEANZAY/configure.wrf.uncoupled_movingnest_terrain_landuse create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/CONFIGURE_WRF/JEANZAY/configure.wrf.uncoupled_xios create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/CONFIGURE_WRF/LEFTRARU/configure.wrf.coupled create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/CONFIGURE_WRF/LEFTRARU/configure.wrf.uncoupled create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/CONFIGURE_WRF/Linux/configure.wrf.coupled create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/CONFIGURE_WRF/Linux/configure.wrf.uncoupled create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/DATARMOR.compile.wrf.pbs create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/IRENE.compile.wrf.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/JEANZAY.compile.wrf.slurm create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/LEFTRARU.compile.wrf.slurm create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/README.compile create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/README.namelist create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/configure.namelist.real create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/job.real.pbs create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/job.real.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/job.real.slurm create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/job.real.slurm.LEFTRARU create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/make_WRF_compil create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/myoutfields.txt create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/namelist.input.base.complete create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WRF_IN/run_real.bash create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WW3_IN/make_WW3_compil create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WW3_IN/switch_aw create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WW3_IN/switch_frc create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WW3_IN/switch_ow create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WW3_IN/switch_owa create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WW3_IN/ww3_bounc.inp create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WW3_IN/ww3_grid.inp.base create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WW3_IN/ww3_ounf.inp.base create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WW3_IN/ww3_ounp.inp.base create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WW3_IN/ww3_prnc.inp.current create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WW3_IN/ww3_prnc.inp.level create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WW3_IN/ww3_prnc.inp.wind create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WW3_IN/ww3_shel.inp.base.Afrc create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WW3_IN/ww3_shel.inp.base.aw create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WW3_IN/ww3_shel.inp.base.frc create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WW3_IN/ww3_shel.inp.base.ow create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WW3_IN/ww3_shel.inp.base.owa create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/WW3_IN/ww3_strt.inp create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/myjob.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/SCRIPTS_COUPLING/submitjob.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/example_job_run_croco.pbs create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/example_job_run_croco.sh create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/example_job_run_croco.slurm create mode 100644 CROCO/croco-v1.3.1/SCRIPTS/example_job_run_croco_inter.pbs create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/IGW_OA/MorletWaveletAnalysis/IGW_tidal_forcing_S2/IGW_S2_rho_oa_MorletS2S4_200-240.gif create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/IGW_OA/MorletWaveletAnalysis/IGW_tidal_forcing_S2/namelist_oa_rho__S2_S4 create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/IGW_OA/MorletWaveletAnalysis/IGW_tidal_forcing_S2/namelist_rho__Wavelet_S2_oa create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/IGW_OA/MorletWaveletAnalysis/IGW_tidal_forcing_S2/namelist_rho__Wavelet_S4_oa create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/IGW_OA/MorletWaveletAnalysis/OnlineAnalysis_Croco_Interface_validation.pdf create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/IGW_OA/MorletWaveletAnalysis/README create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/IGW_OA/MorletWaveletAnalysis/ValidationWithUniformCosines/namelist_oa_test_1800s_900s create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/IGW_OA/MorletWaveletAnalysis/ValidationWithUniformCosines/namelist_oa_test_S2 create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/IGW_OA/MorletWaveletAnalysis/ValidationWithUniformCosines/namelist_oa_test_S2_S4 create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/IGW_OA/MorletWaveletAnalysis/ValidationWithUniformCosines/namelist_oa_test_S4 create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/IGW_OA/MorletWaveletAnalysis/ValidationWithUniformCosines/namelist_test_1800s_Wavelet_oa create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/IGW_OA/MorletWaveletAnalysis/ValidationWithUniformCosines/namelist_test_900s_Wavelet_oa create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/IGW_OA/MorletWaveletAnalysis/ValidationWithUniformCosines/namelist_test_Wavelet_S2_oa create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/IGW_OA/MorletWaveletAnalysis/ValidationWithUniformCosines/namelist_test_Wavelet_S2_oa.freq-analysis-600s.sampling150s create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/IGW_OA/MorletWaveletAnalysis/ValidationWithUniformCosines/namelist_test_Wavelet_S2_oa.hourly-analysis.sampling150s create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/IGW_OA/MorletWaveletAnalysis/ValidationWithUniformCosines/namelist_test_Wavelet_S4_oa create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/IGW_OA/MorletWaveletAnalysis/ValidationWithUniformCosines/namelist_test_Wavelet_S4_oa.freq-analysis-600s.sampling150s create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/IGW_OA/MorletWaveletAnalysis/ValidationWithUniformCosines/namelist_test_Wavelet_S4_oa.hourly-analysis.sampling150s create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/IGW_OA/field_def.xml_full_xios2.5.IGW create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/IGW_OA/file_def.xml.IGW.4days.S2S4.test_3d.4ts.600s create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/IGW_OA/file_def.xml.IGW.8days.S2S4.rho_3d.hourly create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/barocjet.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/barocvortex.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Acoustic create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Ana_dune create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Basin create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Canyon create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.DIURNALCYCLE create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Dune create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Dune3d create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Equator create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Estuary create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.FORCED_DBLEEK create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.FORCED_EKBBL create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.FORCED_NONROTBBL create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.FORCED_OSCNONROTBBL create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Grav_adj create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Grav_adj_nbq create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.IGW create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.IGW_nbq create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Innershelf create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Internal create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Isoliton create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Jet create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.KATO_PHILLIPS create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.KH_INST create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.MovBat create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Overflow create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Rip create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Rip_tides create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.River create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Sandbar create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Sandbar_1B create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Sandbar_1B_nbq create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Sandbar_1C create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Sandbar_1C_nbq create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Sandbar_nbq create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Seamount create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Sed_toy_consolid create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Sed_toy_floc_0d create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Sed_toy_floc_1d create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Sed_toy_resusp create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Sed_toy_rouse create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Shelfront create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.ShoreFace create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Soliton create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Swash create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.TS_adv_body create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.TS_adv_diag create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.TS_adv_rep create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Tank create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Thacker create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Tidal_flat create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Upwelling create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.VILAINE create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Vortex create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.Vortex.1 create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/croco.in.WILLIS_DEARDORFF create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/floats.in.River create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/igw_frc.nc create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/igw_grd.nc create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/make_clim_IGW.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/make_grid_IGW.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/make_jet.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/make_rip.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/make_tides_IGW.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/make_vortex.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/plot_IGW.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/plot_MovBat.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/plot_ana_dune.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/plot_basin.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/plot_canyon.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/plot_dune.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/plot_dune3d.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/plot_equator.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/plot_grav_adj.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/plot_innershelf.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/plot_internal.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/plot_isoliton.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/plot_jet.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/plot_kh_inst.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/plot_overflow.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/plot_rip.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/plot_river.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/plot_sandbar.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/plot_sandbar_nbq.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/plot_seamount.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/plot_sed_toy_consolid.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/plot_sed_toy_resusp.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/plot_sed_toy_rouse.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/plot_shelfront.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/plot_shoreface.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/plot_soliton.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/plot_stations.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/plot_swash.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/plot_tank.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/plot_thacker.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/plot_tidal_flat.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/plot_upwelling.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/plot_vortex.m create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/sediment_ana_dune.in create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/sediment_dune.in create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/sediment_sandbar.in create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/sediment_sandbar_1B.in create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/sediment_sandbar_1B_nbq.in create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/sediment_sandbar_1C.in create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/sediment_sandbar_1C_nbq.in create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/sediment_sed_toy_consolid.in create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/sediment_sed_toy_floc_0d.in create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/sediment_sed_toy_floc_1d.in create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/sediment_sed_toy_resusp.in create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/sediment_sed_toy_rouse.in create mode 100644 CROCO/croco-v1.3.1/TEST_CASES/shoreface_JW_frc.nc create mode 100644 CROCO/croco-v1.3.1/XIOS/README_XIOS create mode 100644 CROCO/croco-v1.3.1/XIOS/context_croco.xml create mode 100644 CROCO/croco-v1.3.1/XIOS/context_wrf.xml create mode 100644 CROCO/croco-v1.3.1/XIOS/domain_def_croco.xml create mode 100644 CROCO/croco-v1.3.1/XIOS/field_def_croco.xml_full_withcpp create mode 100644 CROCO/croco-v1.3.1/XIOS/file_def_croco.xml_full_withcpp create mode 100644 CROCO/croco-v1.3.1/XIOS/file_def_wrf.xml create mode 100644 CROCO/croco-v1.3.1/XIOS/iodef.xml_croco_noxios_wrf_xios create mode 100644 CROCO/croco-v1.3.1/XIOS/iodef.xml_croco_xios create mode 100644 CROCO/croco-v1.3.1/XIOS/iodef.xml_croco_xios_wrf_noxios create mode 100644 CROCO/croco-v1.3.1/XIOS/iodef.xml_croco_xios_wrf_xios create mode 100644 CROCO/croco-v1.3.1/XIOS/iodef.xml_wrf_xios create mode 100644 CROCO/croco-v1.3.1/XIOS/process_xios_xml.sh create mode 100644 CROCO/croco-v1.3.1/XIOS/send_xios_diags.F create mode 100644 CROCO/croco-v1.3.1/XIOS/xios_launch.file create mode 100644 CROCO/croco-v1.3.1/create_config.bash diff --git a/CROCO/croco-v1.3.1/.gitattributes b/CROCO/croco-v1.3.1/.gitattributes new file mode 100644 index 00000000..2e2b4536 --- /dev/null +++ b/CROCO/croco-v1.3.1/.gitattributes @@ -0,0 +1 @@ +*.nc -crlf -diff diff --git a/CROCO/croco-v1.3.1/.gitignore b/CROCO/croco-v1.3.1/.gitignore new file mode 100644 index 00000000..aa08b456 --- /dev/null +++ b/CROCO/croco-v1.3.1/.gitignore @@ -0,0 +1,18 @@ +# Logs and databases # +###################### +*.log +*.output +*.sql +*.sqlite + +# OS generated files # +###################### +.DS_Store* + +# Misc # +###################### +doc/build +Run/* +Run/amr.in + +OCEAN.bak/cpl_prism_getlistvals.F diff --git a/CROCO/croco-v1.3.1/.gitlab-ci.yml b/CROCO/croco-v1.3.1/.gitlab-ci.yml new file mode 100644 index 00000000..3a6e5e00 --- /dev/null +++ b/CROCO/croco-v1.3.1/.gitlab-ci.yml @@ -0,0 +1,120 @@ +# ci croco +# check this file with: https://gitlab.inria.fr/ci/lint +variables: + TERM: "xterm-256color" + CVTKHOME: "$CI_PROJECT_DIR/CVTK/test_repro" + PERFRSTHOME: "$CI_PROJECT_DIR/CVTK/test_perfrst" + # + DATADIR: "$CI_PROJECT_DIR/.datadir" + PERFRSTDIR: "$CI_PROJECT_DIR/.perfrstdir" + # + CVTKWORK: "$CI_PROJECT_DIR/.datawork" + PERFRSTWORK: "$CI_PROJECT_DIR/.perfrstwork" + CROCO_CI_MPIRUN: "mpirun.openmpi" + # + CI_FC: "gfortran" + CI_MPIF90: "mpif90" + CI_CROCO_PWD: $(pwd) + SOURCE_CROCO: "$CI_PROJECT_DIR/OCEAN" + TESTROOTDIR: ${CVTKWORK} + # + # Here define the direcory with the input files + # => for BENGUELA_VHR + DATAREG: "$CI_PROJECT_DIR/../../../../VHR_CROCO_FILES_BCK" + nest_position_reg: "79 137 37 117 3 3 3 3" + # => for VORTEX if needed + DATAVOR: "" + nest_position_vort: "" + # => for ANA if needed + DATAANA: "" + +before_script: + - mkdir -p $DATADIR + - mkdir -p $CVTKWORK + - cd $DATADIR + - mkdir -p TESTROOT/VORT TESTROOT/KTEST TESTROOT/REG + - mkdir -p $PERFRSTDIR + - mkdir -p $PERFRSTWORK + - cd $PERFRSTDIR + - mkdir -p TESTROOT/REG + - cd - + +ana_run: + #only: + # - pushes + script: + - cd $CVTKHOME/Scripts_ana + - ./create_link_master_ana.sh + - cd - + - cd $CVTKWORK/KTEST + + - ./mk_TESTALL.bash CONFIGURE_ANA ana + - ./gather_recap.bash KTEST > /dev/null 2>&1 + - /bin/sh -c '! grep -i "Compilation failure" KTEST_gather_recap_*_git*' > /dev/null 2>&1 + - /bin/sh -c '! grep -i "Execution failure" KTEST_gather_recap_*_git*' > /dev/null 2>&1 + - /bin/sh -c '! grep -i "Parallel reproducibility failed" KTEST_gather_recap_*_git*' > /dev/null 2>&1 + + artifacts: + paths: + - $CVTKWORK/ftp + when: always + +vort_run: + only: + - schedules + script: + - cd $CVTKHOME/Scripts_vort + - ./create_link_master_vort.sh + - cd - + - cd $CVTKWORK/VORT + + - ./mk_TESTALL.bash CONFIGURE_VORT vort + - ./gather_recap.bash VORT > /dev/null 2>&1 + - /bin/sh -c '! grep -i "Compilation failure" VORT_gather_recap_*_git*' > /dev/null 2>&1 + - /bin/sh -c '! grep -i "Execution failure" VORT_gather_recap_*_git*' > /dev/null 2>&1 + - /bin/sh -c '! grep -i "Parallel reproducibility failed" VORT_gather_recap_*_git*' > /dev/null 2>&1 + + artifacts: + paths: + - $CVTKWORK/ftp + when: always + +reg_run: + only: + - schedules + script: + - cd $CVTKHOME/Scripts_reg + - ./create_link_master_reg.sh + - cd - + - cd $CVTKWORK/REG + + - ./mk_TESTALL.bash CONFIGURE_REG reg + - ./gather_recap.bash REG > /dev/null 2>&1 + - /bin/sh -c '! grep -i "Compilation failure" REG_gather_recap_*_git*' > /dev/null 2>&1 + - /bin/sh -c '! grep -i "Execution failure" REG_gather_recap_*_git*' > /dev/null 2>&1 + - /bin/sh -c '! grep -i "Parallel reproducibility failed" REG_gather_recap_*_git*' > /dev/null 2>&1 + + artifacts: + paths: + - $CVTKWORK/ftp + when: always + +reg_perfrst: + only: + - schedules + script: + - cd $PERFRSTHOME/Scripts_reg_perfrst + - ./create_link_master_reg_perfrst.sh + - cd - + - cd $PERFRSTWORK/REG + + - ./mk_TESTALL_perfrst.bash CONFIGURE_REG_PERFRST reg + - ./gather_recap_perfrst.bash REG > /dev/null 2>&1 + - /bin/sh -c '! grep -i "Compilation failure" REG_gather_recap_*_git*' > /dev/null 2>&1 + - /bin/sh -c '! grep -i "Execution failure" REG_gather_recap_*_git*' > /dev/null 2>&1 + - /bin/sh -c '! grep -i "Restartabilty failed" REG_gather_recap_*_git*' > /dev/null 2>&1 + + artifacts: + paths: + - $PERFRSTWORK/ftp + when: always diff --git a/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modarrays.F90 b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modarrays.F90 new file mode 100644 index 00000000..993f3176 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modarrays.F90 @@ -0,0 +1,842 @@ +! +! $Id: modarrays.F 662 2007-05-25 15:58:52Z opalod $ +! +! AGRIF (Adaptive Grid Refinement In Fortran) +! +! Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr) +! Christophe Vouland (Christophe.Vouland@imag.fr) +! +! This program is free software; you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation; either version 2 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program; if not, write to the Free Software +! Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA. +! +! +!> Module Agrif_Arrays +! +module Agrif_Arrays +! + use Agrif_Types + use Agrif_Grids +! + implicit none +! +#if defined AGRIF_MPI + interface + subroutine Agrif_InvLoc ( indloc, proc_id, dir, indglob ) + integer, intent(in) :: indloc !< local index + integer, intent(in) :: proc_id !< rank of the proc calling this function + integer, intent(in) :: dir !< direction of the index + integer, intent(out) :: indglob !< global index + end subroutine Agrif_InvLoc + end interface + private :: Agrif_InvLoc +#endif +! +contains +! +!=================================================================================================== +! subroutine Agrif_Childbounds +! +!> Computes the global indices of the child grid +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Childbounds ( nbdim, & + lb_var, ub_var, & + lb_tab, ub_tab, & + proc_id, & + coords, & + lb_tab_true, ub_tab_true, memberin, & + indminglob3,indmaxglob3) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: nbdim !< Number of dimensions + integer, dimension(nbdim), intent(in) :: lb_var !< Local lower boundary on the current processor + integer, dimension(nbdim), intent(in) :: ub_var !< Local upper boundary on the current processor + integer, dimension(nbdim), intent(in) :: lb_tab !< Global lower boundary of the variable + integer, dimension(nbdim),OPTIONAL :: indminglob3,indmaxglob3 !< True bounds for MPI USE + integer, dimension(nbdim), intent(in) :: ub_tab !< Global upper boundary of the variable + integer, intent(in) :: proc_id !< Current processor + integer, dimension(nbdim), intent(in) :: coords + integer, dimension(nbdim), intent(out) :: lb_tab_true !< Global value of lb_var on the current processor + integer, dimension(nbdim), intent(out) :: ub_tab_true !< Global value of ub_var on the current processor + logical, intent(out) :: memberin +! + integer :: i, coord_i + integer :: lb_glob_index, ub_glob_index ! Lower and upper global indices +! + do i = 1, nbdim +! + coord_i = coords(i) +! +#if defined AGRIF_MPI + call Agrif_InvLoc( lb_var(i), proc_id, coord_i, lb_glob_index ) + call Agrif_InvLoc( ub_var(i), proc_id, coord_i, ub_glob_index ) + if (present(indminglob3)) then + indminglob3(i)=lb_glob_index + indmaxglob3(i)=ub_glob_index + endif +#else + lb_glob_index = lb_var(i) + ub_glob_index = ub_var(i) +#endif + lb_tab_true(i) = max(lb_tab(i), lb_glob_index) + ub_tab_true(i) = min(ub_tab(i), ub_glob_index) + + enddo +! + memberin = .true. + do i = 1,nbdim + if (ub_tab_true(i) < lb_tab_true(i)) then + memberin = .false. + exit + endif + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Childbounds +!=================================================================================================== +! +!=================================================================================================== +subroutine Agrif_get_var_global_bounds( var, lubglob, nbdim ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Variable), intent(in) :: var + integer, dimension(nbdim,2), intent(out) :: lubglob + integer, intent(in) :: nbdim +! +#if defined AGRIF_MPI + include 'mpif.h' + integer, dimension(nbdim) :: lb, ub + integer, dimension(nbdim,2) :: iminmaxg + integer :: i, code, coord_i +#endif +! +#if !defined AGRIF_MPI + call Agrif_get_var_bounds_array(var, lubglob(:,1), lubglob(:,2), nbdim) +#else + call Agrif_get_var_bounds_array(var, lb, ub, nbdim) + + do i = 1,nbdim + coord_i = var % root_var % coords(i) + call Agrif_InvLoc( lb(i), Agrif_Procrank, coord_i, iminmaxg(i,1) ) + call Agrif_InvLoc( ub(i), Agrif_Procrank, coord_i, iminmaxg(i,2) ) + enddo +! + iminmaxg(1:nbdim,2) = - iminmaxg(1:nbdim,2) + call MPI_ALLREDUCE(iminmaxg, lubglob, 2*nbdim, MPI_INTEGER, MPI_MIN, & + Agrif_mpi_comm, code) + lubglob(1:nbdim,2) = - lubglob(1:nbdim,2) +#endif +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_get_var_global_bounds +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_get_var_bounds +! +!> Gets the lower and the upper boundaries of a variable, for one particular direction. +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_get_var_bounds ( variable, lower, upper, index ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Variable), intent(in) :: variable !< Variable for which we want to extract boundaries + integer, intent(out) :: lower !< Lower bound + integer, intent(out) :: upper !< Upper bound + integer, intent(in) :: index !< Direction for wich we want to know the boundaries +! + lower = variable % lb(index) + upper = variable % ub(index) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_get_var_bounds +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_get_var_bounds_array +! +!> Gets the lower and the upper boundaries of a table. +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_get_var_bounds_array ( variable, lower, upper, nbdim ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Variable), intent(in) :: variable !< Variable for which we want to extract boundaries + integer, dimension(nbdim), intent(out) :: lower !< Lower bounds array + integer, dimension(nbdim), intent(out) :: upper !< Upper bounds array + integer, intent(in) :: nbdim !< Numer of dimensions of the variable +! + lower = variable % lb(1:nbdim) + upper = variable % ub(1:nbdim) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_get_var_bounds_array +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_array_allocate +! +!> Allocates data array in \b variable, according to the required dimension. +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_array_allocate ( variable, lb, ub, nbdim ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Variable), intent(inout) :: variable !< Variable struct for allocation + integer, dimension(nbdim), intent(in) :: lb !< Lower bound + integer, dimension(nbdim), intent(in) :: ub !< Upper bound + integer, intent(in) :: nbdim !< Dimension of the array +! + select case (nbdim) + case (1) ; allocate(variable%array1(lb(1):ub(1))) + case (2) ; allocate(variable%array2(lb(1):ub(1),lb(2):ub(2))) + case (3) ; allocate(variable%array3(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3))) + case (4) ; allocate(variable%array4(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4))) + case (5) ; allocate(variable%array5(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5))) + case (6) ; allocate(variable%array6(lb(1):ub(1),lb(2):ub(2),lb(3):ub(3),lb(4):ub(4),lb(5):ub(5),lb(6):ub(6))) + end select +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_array_allocate +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_array_deallocate +! +!> Dellocates data array in \b variable, according to the required dimension. +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_array_deallocate ( variable, nbdim ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Variable), intent(inout) :: variable !< Variable struct for deallocation + integer, intent(in) :: nbdim !< Dimension of the array +! + select case (nbdim) + case (1) ; deallocate(variable%array1) + case (2) ; deallocate(variable%array2) + case (3) ; deallocate(variable%array3) + case (4) ; deallocate(variable%array4) + case (5) ; deallocate(variable%array5) + case (6) ; deallocate(variable%array6) + end select +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_array_deallocate +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_var_set_array_tozero +! +!> Reset the value of the data array in \b variable, according to the required dimension. +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_var_set_array_tozero ( variable, nbdim ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Variable), intent(inout) :: variable !< Variable + integer, intent(in) :: nbdim !< Dimension of the array you want to reset +! + select case (nbdim) + case (1) ; call Agrif_set_array_tozero_1D(variable%array1) + case (2) ; call Agrif_set_array_tozero_2D(variable%array2) + case (3) ; call Agrif_set_array_tozero_3D(variable%array3) + case (4) ; call Agrif_set_array_tozero_4D(variable%array4) + case (5) ; call Agrif_set_array_tozero_5D(variable%array5) + case (6) ; call Agrif_set_array_tozero_6D(variable%array6) + end select +!--------------------------------------------------------------------------------------------------- +contains +!--------------------------------------------------------------------------------------------------- + subroutine Agrif_set_array_tozero_1D ( array ) + real, dimension(:), intent(out) :: array + array = 0. + end subroutine Agrif_set_array_tozero_1D +! + subroutine Agrif_set_array_tozero_2D ( array ) + real, dimension(:,:), intent(out) :: array + array = 0. + end subroutine Agrif_set_array_tozero_2D +! + subroutine Agrif_set_array_tozero_3D ( array ) + real, dimension(:,:,:), intent(out) :: array + array = 0. + end subroutine Agrif_set_array_tozero_3D +! + subroutine Agrif_set_array_tozero_4D ( array ) + real, dimension(:,:,:,:), intent(out) :: array + array = 0. + end subroutine Agrif_set_array_tozero_4D +! + subroutine Agrif_set_array_tozero_5D ( array ) + real, dimension(:,:,:,:,:), intent(out) :: array + array = 0. + end subroutine Agrif_set_array_tozero_5D +! + subroutine Agrif_set_array_tozero_6D ( array ) + real, dimension(:,:,:,:,:,:), intent(out) :: array + array = 0. + end subroutine Agrif_set_array_tozero_6D +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_var_set_array_tozero +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_var_copy_array +! +!> Copy a part of data array from var2 to var1 +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_var_copy_array ( var1, inf1, sup1, var2, inf2, sup2, nbdim ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Variable), intent(inout) :: var1 !< Modified variable + integer, dimension(nbdim), intent(in) :: inf1 !< Lower boundary for var1 + integer, dimension(nbdim), intent(in) :: sup1 !< Upper boundary for var1 + type(Agrif_Variable), intent(in) :: var2 !< Input variable + integer, dimension(nbdim), intent(in) :: inf2 !< Lower boundary for var2 + integer, dimension(nbdim), intent(in) :: sup2 !< Upper boundary for var2 + integer, intent(in) :: nbdim !< Dimension of the array +! + select case (nbdim) + case (1) ; var1%array1(inf1(1):sup1(1)) = var2%array1(inf2(1):sup2(1)) + case (2) ; call Agrif_copy_array_2d( var1%array2, var2%array2, & + lbound(var1%array2), lbound(var2%array2), inf1, sup1, inf2, sup2 ) + case (3) ; call Agrif_copy_array_3d( var1%array3, var2%array3, & + lbound(var1%array3), lbound(var2%array3), inf1, sup1, inf2, sup2 ) + case (4) ; call Agrif_copy_array_4d( var1%array4, var2%array4, & + lbound(var1%array4), lbound(var2%array4), inf1, sup1, inf2, sup2 ) + case (5) ; var1%array5(inf1(1):sup1(1), & + inf1(2):sup1(2), & + inf1(3):sup1(3), & + inf1(4):sup1(4), & + inf1(5):sup1(5)) = var2%array5(inf2(1):sup2(1), & + inf2(2):sup2(2), & + inf2(3):sup2(3), & + inf2(4):sup2(4), & + inf2(5):sup2(5)) + case (6) ; var1%array6(inf1(1):sup1(1), & + inf1(2):sup1(2), & + inf1(3):sup1(3), & + inf1(4):sup1(4), & + inf1(5):sup1(5), & + inf1(6):sup1(6)) = var2%array6(inf2(1):sup2(1), & + inf2(2):sup2(2), & + inf2(3):sup2(3), & + inf2(4):sup2(4), & + inf2(5):sup2(5), & + inf2(6):sup2(6)) + end select +!--------------------------------------------------------------------------------------------------- +contains +!--------------------------------------------------------------------------------------------------- + subroutine Agrif_copy_array_2d ( tabout, tabin, l, m, inf1, sup1, inf2, sup2 ) + integer, dimension(2), intent(in) :: l, m + integer, dimension(2), intent(in) :: inf1, sup1 + integer, dimension(2), intent(in) :: inf2, sup2 + real, dimension(l(1):,l(2):), intent(out) :: tabout + real, dimension(m(1):,m(2):), intent(in) :: tabin + tabout(inf1(1):sup1(1), & + inf1(2):sup1(2)) = tabin(inf2(1):sup2(1), & + inf2(2):sup2(2)) + end subroutine Agrif_copy_array_2d +! + subroutine Agrif_copy_array_3d ( tabout, tabin, l, m, inf1, sup1, inf2, sup2 ) + integer, dimension(3), intent(in) :: l, m + integer, dimension(3), intent(in) :: inf1, sup1 + integer, dimension(3), intent(in) :: inf2,sup2 + real, dimension(l(1):,l(2):,l(3):), intent(out) :: tabout + real, dimension(m(1):,m(2):,m(3):), intent(in) :: tabin + tabout(inf1(1):sup1(1), & + inf1(2):sup1(2), & + inf1(3):sup1(3)) = tabin(inf2(1):sup2(1), & + inf2(2):sup2(2), & + inf2(3):sup2(3)) + end subroutine Agrif_copy_array_3d +! + subroutine Agrif_copy_array_4d ( tabout, tabin, l, m, inf1, sup1, inf2, sup2 ) + integer, dimension(4), intent(in) :: l, m + integer, dimension(4), intent(in) :: inf1, sup1 + integer, dimension(4), intent(in) :: inf2, sup2 + real, dimension(l(1):,l(2):,l(3):,l(4):), intent(out) :: tabout + real, dimension(m(1):,m(2):,m(3):,m(4):), intent(in) :: tabin + tabout(inf1(1):sup1(1), & + inf1(2):sup1(2), & + inf1(3):sup1(3), & + inf1(4):sup1(4)) = tabin(inf2(1):sup2(1), & + inf2(2):sup2(2), & + inf2(3):sup2(3), & + inf2(4):sup2(4)) + end subroutine Agrif_copy_array_4d +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_var_copy_array +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_var_full_copy_array +! +!> Copy the full data array from var2 to var1 +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_var_full_copy_array ( var1, var2, nbdim ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Variable), intent(inout) :: var1 !< Modified variable + type(Agrif_Variable), intent(in) :: var2 !< Input variable + integer, intent(in) :: nbdim !< Dimension of the array +! + select case (nbdim) + case (1) ; var1 % array1 = var2 % array1 + case (2) ; var1 % array2 = var2 % array2 + case (3) ; var1 % array3 = var2 % array3 + case (4) ; var1 % array4 = var2 % array4 + case (5) ; var1 % array5 = var2 % array5 + case (6) ; var1 % array6 = var2 % array6 + end select +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_var_full_copy_array +!=================================================================================================== +! +!=================================================================================================== +! subroutine GiveAgrif_SpecialValueToTab_mpi +! +!> Copy \b value in data array \b var2 where it is present in \b var1. +!--------------------------------------------------------------------------------------------------- +subroutine GiveAgrif_SpecialValueToTab_mpi ( var1, var2, bounds, value, nbdim ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Variable), intent(in) :: var1 !< Modified variable + type(Agrif_Variable), intent(inout) :: var2 !< Input variable + integer, dimension(:,:,:), intent(in) :: bounds !< Bound for both arrays + real, intent(in) :: value !< Special value + integer, intent(in) :: nbdim !< Dimension of the array +! + select case (nbdim) + case (1) + where (var1 % array1(bounds(1,1,2):bounds(1,2,2)) == value ) + var2 % array1(bounds(1,1,1):bounds(1,2,1)) = value + end where + case (2) + where (var1 % array2(bounds(1,1,2):bounds(1,2,2), & + bounds(2,1,2):bounds(2,2,2)) == value) + var2 % array2(bounds(1,1,1):bounds(1,2,1), & + bounds(2,1,1):bounds(2,2,1)) = value + end where + case (3) + where (var1 % array3(bounds(1,1,2):bounds(1,2,2), & + bounds(2,1,2):bounds(2,2,2), & + bounds(3,1,2):bounds(3,2,2)) == value) + var2 % array3(bounds(1,1,1):bounds(1,2,1), & + bounds(2,1,1):bounds(2,2,1), & + bounds(3,1,1):bounds(3,2,1)) = value + end where + case (4) + where (var1 % array4(bounds(1,1,2):bounds(1,2,2), & + bounds(2,1,2):bounds(2,2,2), & + bounds(3,1,2):bounds(3,2,2), & + bounds(4,1,2):bounds(4,2,2)) == value) + var2 % array4(bounds(1,1,1):bounds(1,2,1), & + bounds(2,1,1):bounds(2,2,1), & + bounds(3,1,1):bounds(3,2,1), & + bounds(4,1,1):bounds(4,2,1)) = value + end where + case (5) + where (var1 % array5(bounds(1,1,2):bounds(1,2,2), & + bounds(2,1,2):bounds(2,2,2), & + bounds(3,1,2):bounds(3,2,2), & + bounds(4,1,2):bounds(4,2,2), & + bounds(5,1,2):bounds(5,2,2)) == value) + var2 % array5(bounds(1,1,1):bounds(1,2,1), & + bounds(2,1,1):bounds(2,2,1), & + bounds(3,1,1):bounds(3,2,1), & + bounds(4,1,1):bounds(4,2,1), & + bounds(5,1,1):bounds(5,2,1)) = value + end where + case (6) + where (var1 % array6(bounds(1,1,2):bounds(1,2,2), & + bounds(2,1,2):bounds(2,2,2), & + bounds(3,1,2):bounds(3,2,2), & + bounds(4,1,2):bounds(4,2,2), & + bounds(5,1,2):bounds(5,2,2), & + bounds(6,1,2):bounds(6,2,2)) == value) + var2 % array6(bounds(1,1,1):bounds(1,2,1), & + bounds(2,1,1):bounds(2,2,1), & + bounds(3,1,1):bounds(3,2,1), & + bounds(4,1,1):bounds(4,2,1), & + bounds(5,1,1):bounds(5,2,1), & + bounds(6,1,1):bounds(6,2,1)) = value + end where + end select +!--------------------------------------------------------------------------------------------------- +end subroutine GiveAgrif_SpecialValueToTab_mpi +!=================================================================================================== +! +! no more used ??? +#if 0 +!=================================================================================================== +! subroutine GiveAgrif_SpecialValueToTab +!--------------------------------------------------------------------------------------------------- +subroutine GiveAgrif_SpecialValueToTab ( var1, var2, & + lower, upper, Value, nbdim ) +!--------------------------------------------------------------------------------------------------- + TYPE(Agrif_Variable), pointer :: var1 + TYPE(Agrif_Variable), pointer :: var2 + INTEGER, intent(in) :: nbdim + INTEGER, DIMENSION(nbdim), intent(in) :: lower, upper + REAL, intent(in) :: Value +! + select case (nbdim) + case (1) + where (var1 % array1( lower(1):upper(1)) == Value) + var2 % array1(lower(1):upper(1)) = Value + end where + case (2) + where (var1 % array2( lower(1):upper(1), & + lower(2):upper(2)) == Value) + var2 % array2(lower(1):upper(1), & + lower(2):upper(2)) = Value + end where + case (3) + where (var1 % array3( lower(1):upper(1), & + lower(2):upper(2), & + lower(3):upper(3)) == Value) + var2 % array3(lower(1):upper(1), & + lower(2):upper(2), & + lower(3):upper(3)) = Value + end where + case (4) + where (var1 % array4( lower(1):upper(1), & + lower(2):upper(2), & + lower(3):upper(3), & + lower(4):upper(4)) == Value) + var2 % array4(lower(1):upper(1), & + lower(2):upper(2), & + lower(3):upper(3), & + lower(4):upper(4)) = Value + end where + case (5) + where (var1 % array5( lower(1):upper(1), & + lower(2):upper(2), & + lower(3):upper(3), & + lower(4):upper(4), & + lower(5):upper(5)) == Value) + var2 % array5(lower(1):upper(1), & + lower(2):upper(2), & + lower(3):upper(3), & + lower(4):upper(4), & + lower(5):upper(5)) = Value + end where + case (6) + where (var1 % array6( lower(1):upper(1), & + lower(2):upper(2), & + lower(3):upper(3), & + lower(4):upper(4), & + lower(5):upper(5), & + lower(6):upper(6)) == Value) + var2 % array6(lower(1):upper(1), & + lower(2):upper(2), & + lower(3):upper(3), & + lower(4):upper(4), & + lower(5):upper(5), & + lower(6):upper(6)) = Value + end where + end select +!--------------------------------------------------------------------------------------------------- +end subroutine GiveAgrif_SpecialValueToTab +!=================================================================================================== +#endif +! +#if defined AGRIF_MPI +!=================================================================================================== +! subroutine Agrif_var_replace_value +! +!> Replace \b value by \var2 content in \var1 data array. +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_var_replace_value ( var1, var2, lower, upper, value, nbdim ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Variable), intent(inout) :: var1 !< Modified variable + type(Agrif_Variable), intent(in) :: var2 !< Input variable + integer, dimension(nbdim), intent(in) :: lower !< Lower bound + integer, dimension(nbdim), intent(in) :: upper !< Upper bound + real, intent(in) :: value !< Special value + integer, intent(in) :: nbdim !< Dimension of the array +! + integer :: i,j,k,l,m,n +! + select case (nbdim) + case (1) + do i = lower(1),upper(1) + if (var1%array1(i) == value) then + var1%array1(i) = var2%array1(i) + endif + enddo + case (2) + do j = lower(2),upper(2) + do i = lower(1),upper(1) + if (var1%array2(i,j) == value) then + var1%array2(i,j) = var2%array2(i,j) + endif + enddo + enddo + case (3) + do k = lower(3),upper(3) + do j = lower(2),upper(2) + do i = lower(1),upper(1) + if (var1%array3(i,j,k) == value) then + var1%array3(i,j,k) = var2%array3(i,j,k) + endif + enddo + enddo + enddo + case (4) + do l = lower(4),upper(4) + do k = lower(3),upper(3) + do j = lower(2),upper(2) + do i = lower(1),upper(1) + if (var1%array4(i,j,k,l) == value) then + var1%array4(i,j,k,l) = var2%array4(i,j,k,l) + endif + enddo + enddo + enddo + enddo + case (5) + do m = lower(5),upper(5) + do l = lower(4),upper(4) + do k = lower(3),upper(3) + do j = lower(2),upper(2) + do i = lower(1),upper(1) + if (var1%array5(i,j,k,l,m) == value) then + var1%array5(i,j,k,l,m) = var2%array5(i,j,k,l,m) + endif + enddo + enddo + enddo + enddo + enddo + case (6) + do n = lower(6),upper(6) + do m = lower(5),upper(5) + do l = lower(4),upper(4) + do k = lower(3),upper(3) + do j = lower(2),upper(2) + do i = lower(1),upper(1) + if (var1%array6(i,j,k,l,m,n) == value) then + var1%array6(i,j,k,l,m,n) = var2%array6(i,j,k,l,m,n) + endif + enddo + enddo + enddo + enddo + enddo + enddo + end select +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_var_replace_value +!=================================================================================================== +#endif +! +!=================================================================================================== +! subroutine PreProcessToInterpOrUpdate +!--------------------------------------------------------------------------------------------------- +subroutine PreProcessToInterpOrUpdate ( parent, child, & + nb_child, ub_child, & + lb_child, lb_parent, & + s_child, s_parent, & + ds_child, ds_parent, nbdim, interp ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Variable), pointer, intent(in) :: parent !< Variable on the parent grid + type(Agrif_Variable), pointer, intent(in) :: child !< Variable on the child grid + integer, dimension(6), intent(out) :: nb_child !< Number of cells on the child grid + integer, dimension(6), intent(out) :: ub_child !< Upper bound on the child grid + integer, dimension(6), intent(out) :: lb_child !< Lower bound on the child grid + integer, dimension(6), intent(out) :: lb_parent !< Lower bound on the parent grid + real, dimension(6), intent(out) :: s_child !< Child grid position (s_root = 0) + real, dimension(6), intent(out) :: s_parent !< Parent grid position (s_root = 0) + real, dimension(6), intent(out) :: ds_child !< Child grid dx (ds_root = 1) + real, dimension(6), intent(out) :: ds_parent !< Parent grid dx (ds_root = 1) + integer, intent(out) :: nbdim !< Number of dimensions + logical, intent(in) :: interp !< .true. if preprocess for interpolation, \n + !! .false. if preprocess for update +! + type(Agrif_Variable), pointer :: root_var + type(Agrif_Grid), pointer :: Agrif_Child_Gr + type(Agrif_Grid), pointer :: Agrif_Parent_Gr + integer :: n +! + Agrif_Child_Gr => Agrif_Curgrid + Agrif_Parent_Gr => Agrif_Curgrid % parent +! + root_var => child % root_var +! +! Number of dimensions of the current grid + nbdim = root_var % nbdim +! + do n = 1,nbdim +! +! Value of interptab(n) can be either x,y,z or N for a no space dimension + select case(root_var % interptab(n)) +! + case('x') +! + lb_child(n) = root_var % point(n) + lb_parent(n) = root_var % point(n) + nb_child(n) = Agrif_Child_Gr % nb(1) + s_child(n) = Agrif_Child_Gr % Agrif_x(1) + s_parent(n) = Agrif_Parent_Gr % Agrif_x(1) + ds_child(n) = Agrif_Child_Gr % Agrif_dx(1) + ds_parent(n) = Agrif_Parent_Gr % Agrif_dx(1) +! + if ( root_var % posvar(n) == 1 ) then + ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(1) + else + ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(1) - 1 + s_child(n) = s_child(n) + 0.5*ds_child(n) + s_parent(n) = s_parent(n) + 0.5*ds_parent(n) + endif +! + case('y') +! + lb_child(n) = root_var % point(n) + lb_parent(n) = root_var % point(n) + nb_child(n) = Agrif_Child_Gr % nb(2) + s_child(n) = Agrif_Child_Gr % Agrif_x(2) + s_parent(n) = Agrif_Parent_Gr % Agrif_x(2) + ds_child(n) = Agrif_Child_Gr % Agrif_dx(2) + ds_parent(n) = Agrif_Parent_Gr % Agrif_dx(2) +! + if (root_var % posvar(n)==1) then + ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(2) + else + ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(2) - 1 + s_child(n) = s_child(n) + 0.5*ds_child(n) + s_parent(n) = s_parent(n) + 0.5*ds_parent(n) + endif +! + case('z') +! + lb_child(n) = root_var % point(n) + lb_parent(n) = root_var % point(n) + nb_child(n) = Agrif_Child_Gr % nb(3) + s_child(n) = Agrif_Child_Gr % Agrif_x(3) + s_parent(n) = Agrif_Parent_Gr % Agrif_x(3) + ds_child(n) = Agrif_Child_Gr % Agrif_dx(3) + ds_parent(n) = Agrif_Parent_Gr % Agrif_dx(3) +! + if (root_var % posvar(n)==1) then + ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(3) + else + ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(3) - 1 + s_child(n) = s_child(n) + 0.5*ds_child(n) + s_parent(n) = s_parent(n) + 0.5*ds_parent(n) + endif +! + case('N') ! No space dimension +! +! The next coefficients are calculated in order to do a simple copy of +! values of the grid variable when the interpolation routine is +! called for this dimension. +! + if (interp) then + call Agrif_get_var_bounds(parent, lb_child(n), ub_child(n), n) + nb_child(n) = parent % ub(n) - parent % lb(n) + else + call Agrif_get_var_bounds(child, lb_child(n), ub_child(n), n) + nb_child(n) = child % ub(n) - child % lb(n) + endif +! +! No interpolation but only a copy of the values of the grid variable + lb_parent(n) = lb_child(n) + s_child(n) = 0. + s_parent(n) = 0. + ds_child(n) = 1. + ds_parent(n) = 1. +! + end select +! + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine PreProcessToInterpOrUpdate +!=================================================================================================== +! +#if defined AGRIF_MPI +!=================================================================================================== +! subroutine Agrif_GetLocalBoundaries +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_GetLocalBoundaries ( tab1, tab2, coord, lb, ub, deb, fin ) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: tab1 + integer, intent(in) :: tab2 + integer, intent(in) :: coord + integer, intent(in) :: lb, ub + integer, intent(out) :: deb, fin +! + integer :: imin, imax + integer :: i1, i2 +! + call Agrif_InvLoc(lb, AGRIF_ProcRank, coord, imin) + call Agrif_InvLoc(ub, AGRIF_ProcRank, coord, imax) +! + if ( imin > tab2 ) then + i1 = imax - imin + else + i1 = max(tab1 - imin,0) + endif +! + if (imax < tab1) then + i2 = -(imax - imin) + else + i2 = min(tab2 - imax,0) + endif +! + deb = lb + i1 + fin = ub + i2 +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_GetLocalBoundaries +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_GlobalToLocalBounds +! +!> For a global index located on the current processor, tabarray gives the corresponding local index +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_GlobalToLocalBounds ( locbounds, lb_var, ub_var, lb_glob, ub_glob, & + coords, nbdim, rank, member ) +!--------------------------------------------------------------------------------------------------- + integer, dimension(nbdim,2,2), intent(out) :: locbounds !< Local values of \b lb_glob and \b ub_glob + integer, dimension(nbdim), intent(in) :: lb_var !< Local lower boundary on the current processor + integer, dimension(nbdim), intent(in) :: ub_var !< Local upper boundary on the current processor + integer, dimension(nbdim), intent(in) :: lb_glob !< Global lower boundary + integer, dimension(nbdim), intent(in) :: ub_glob !< Global upper boundary + integer, dimension(nbdim), intent(in) :: coords + integer, intent(in) :: nbdim !< Dimension of the array + integer, intent(in) :: rank !< Rank of the processor + logical, intent(out) :: member +! + integer :: i, i1, k + integer :: nbloc(nbdim) +! + locbounds(:,1,:) = HUGE(1) + locbounds(:,2,:) = -HUGE(1) +! + nbloc = 0 +! + do i = 1,nbdim +! + if (coords(i) == 0) then + nbloc(i) = 1 + locbounds(i,1,1) = lb_glob(i) + locbounds(i,2,1) = ub_glob(i) + locbounds(i,1,2) = lb_glob(i) + locbounds(i,2,2) = ub_glob(i) + else + call Agrif_InvLoc(lb_var(i), rank, coords(i), i1) +! + do k = lb_glob(i)+lb_var(i)-i1,ub_glob(i)+lb_var(i)-i1 +! + if ( (k >= lb_var(i)) .AND. (k <= ub_var(i)) ) then + nbloc(i) = 1 + locbounds(i,1,1) = min(locbounds(i,1,1),k-lb_var(i)+i1) + locbounds(i,2,1) = max(locbounds(i,2,1),k-lb_var(i)+i1) + + locbounds(i,1,2) = min(locbounds(i,1,2),k) + locbounds(i,2,2) = max(locbounds(i,2,2),k) + endif + enddo + endif + enddo + + member = ( sum(nbloc) == nbdim ) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_GlobalToLocalBounds +!=================================================================================================== +#endif +! +end module Agrif_Arrays diff --git a/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modbc.F90 b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modbc.F90 new file mode 100644 index 00000000..cee8954f --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modbc.F90 @@ -0,0 +1,649 @@ +! +! $Id: modbc.F 779 2007-12-22 17:04:17Z rblod $ +! +! AGRIF (Adaptive Grid Refinement In Fortran) +! +! Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr) +! Christophe Vouland (Christophe.Vouland@imag.fr) +! +! This program is free software; you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation; either version 2 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program; if not, write to the Free Software +! Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA. +! +! +!> Module Agrif_Boundary. +!> +!> Contains subroutines to calculate the boundary conditions on the child grids from their +!> parent grids. +! +module Agrif_Boundary +! + use Agrif_Interpolation +! + implicit none +! +contains +! +!=================================================================================================== +! subroutine Agrif_CorrectVariable +! +!> subroutine to calculate the boundary conditions on a fine grid +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_CorrectVariable ( parent, child, pweight, weight, procname ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Variable), pointer :: parent !< Variable on the parent grid + type(Agrif_Variable), pointer :: child !< Variable on the child grid + logical :: pweight !< Indicates if weight is used for the time interpolation + real :: weight !< Coefficient for the time interpolation + procedure() :: procname !< Data recovery procedure +! + type(Agrif_Grid) , pointer :: Agrif_Child_Gr, Agrif_Parent_Gr + type(Agrif_Variable), pointer :: root_var ! Variable on the root grid + integer :: nbdim ! Number of dimensions of the grid variable + integer :: n + integer, dimension(6) :: lb_child ! Index of the first point inside the domain for + ! the child grid variable + integer, dimension(6) :: lb_parent ! Index of the first point inside the domain for + ! the parent grid variable + integer, dimension(6) :: ub_child ! Upper bound on the child grid + integer, dimension(6) :: nb_child ! Number of cells for child + integer, dimension(6) :: posvartab_child ! Position of the variable on the cell + integer, dimension(6) :: loctab_child ! Indicates if the child grid has a common border + ! with the root grid + real, dimension(6) :: s_child, s_parent ! Positions of the parent and child grids + real, dimension(6) :: ds_child, ds_parent ! Space steps of the parent and child grids +! + call PreProcessToInterpOrUpdate( parent, child, & + nb_child, ub_child, & + lb_child, lb_parent, & + s_child, s_parent, & + ds_child, ds_parent, nbdim, interp=.true.) + root_var => child % root_var + Agrif_Child_Gr => Agrif_Curgrid + Agrif_Parent_Gr => Agrif_Curgrid % parent +! + loctab_child(:) = 0 + posvartab_child(1:nbdim) = root_var % posvar(1:nbdim) +! + do n = 1,nbdim +! + select case(root_var % interptab(n)) +! + case('x') ! x DIMENSION +! + if (Agrif_Curgrid % NearRootBorder(1)) loctab_child(n) = -1 + if (Agrif_Curgrid % DistantRootBorder(1)) loctab_child(n) = -2 + if ((Agrif_Curgrid % NearRootBorder(1)) .AND. & + (Agrif_Curgrid % DistantRootBorder(1))) loctab_child(n) = -3 +! + case('y') ! y DIMENSION +! + if (Agrif_Curgrid % NearRootBorder(2)) loctab_child(n) = -1 + if (Agrif_Curgrid % DistantRootBorder(2)) loctab_child(n) = -2 + if ((Agrif_Curgrid % NearRootBorder(2)) .AND. & + (Agrif_Curgrid % DistantRootBorder(2))) loctab_child(n) = -3 +! + case('z') ! z DIMENSION +! + if (Agrif_Curgrid % NearRootBorder(3)) loctab_child(n) = -1 + if (Agrif_Curgrid % DistantRootBorder(3)) loctab_child(n) = -2 + if ((Agrif_Curgrid % NearRootBorder(3)) .AND. & + (Agrif_Curgrid % DistantRootBorder(3))) loctab_child(n) = -3 +! + case('N') ! No space DIMENSION +! + posvartab_child(n) = 1 + loctab_child(n) = -3 +! + end select +! + enddo +! + call Agrif_Correctnd(parent, child, pweight, weight, & + lb_child(1:nbdim), lb_parent(1:nbdim), & + nb_child(1:nbdim), posvartab_child(1:nbdim), & + loctab_child(1:nbdim), & + s_child(1:nbdim), s_parent(1:nbdim), & + ds_child(1:nbdim),ds_parent(1:nbdim), nbdim, procname ) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_CorrectVariable +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Correctnd +! +!> calculates the boundary conditions for a nD grid variable on a fine grid by using +!> a space and time interpolations; it is called by the #Agrif_CorrectVariable procedure +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Correctnd ( parent, child, pweight, weight, & + pttab_child, pttab_Parent, & + nbtab_Child, posvartab_Child, loctab_Child, & + s_Child, s_Parent, ds_Child, ds_Parent, & + nbdim, procname ) +!--------------------------------------------------------------------------------------------------- +#if defined AGRIF_MPI + include 'mpif.h' +#endif +! + TYPE(Agrif_Variable), pointer :: parent !< Variable on the parent grid + TYPE(Agrif_Variable), pointer :: child !< Variable on the child grid + LOGICAL :: pweight !< Indicates if weight is used for the temporal interpolation + REAL :: weight !< Coefficient for the temporal interpolation + INTEGER, DIMENSION(nbdim) :: pttab_child !< Index of the first point inside the domain for the parent grid variable + INTEGER, DIMENSION(nbdim) :: pttab_Parent !< Index of the first point inside the domain for the child grid variable + INTEGER, DIMENSION(nbdim) :: nbtab_Child !< Number of cells of the child grid + INTEGER, DIMENSION(nbdim) :: posvartab_Child !< Position of the grid variable (1 or 2) + INTEGER, DIMENSION(nbdim) :: loctab_Child !< Indicates if the child grid has a common border with the root grid + REAL , DIMENSION(nbdim) :: s_Child, s_Parent !< Positions of the parent and child grids + REAL , DIMENSION(nbdim) :: ds_Child, ds_Parent !< Space steps of the parent and child grids + INTEGER :: nbdim !< Number of dimensions of the grid variable + procedure() :: procname !< Data recovery procedure +! + INTEGER,DIMENSION(6) :: type_interp ! Type of interpolation (linear, spline,...) + INTEGER,DIMENSION(6,6) :: type_interp_bc ! Type of interpolation (linear, spline,...) + INTEGER,DIMENSION(nbdim,2,2) :: childarray + INTEGER,DIMENSION(nbdim,2) :: lubglob + INTEGER :: kindex ! Index used for safeguard and time interpolation + INTEGER,DIMENSION(nbdim,2,2) :: indtab ! Arrays indicating the limits of the child + INTEGER,DIMENSION(nbdim,2,2) :: indtruetab ! grid variable where boundary conditions are + INTEGER,DIMENSION(nbdim,2,2,nbdim) :: ptres,ptres2 ! calculated + INTEGER,DIMENSION(nbdim) :: coords + INTEGER :: i, nb, ndir + INTEGER :: n, sizetab + INTEGER :: ibeg, iend + INTEGER :: i1,i2,j1,j2,k1,k2,l1,l2,m1,m2,n1,n2 + REAL :: c1t,c2t ! Coefficients for the time interpolation (c2t=1-c1t) +#if defined AGRIF_MPI +! + INTEGER, DIMENSION(nbdim) :: lower, upper + INTEGER, DIMENSION(nbdim) :: ltab, utab +! +#endif +! + type_interp_bc = child % root_var % type_interp_bc + coords = child % root_var % coords +! + ibeg = child % bcinf + iend = child % bcsup +! + indtab(1:nbdim,2,1) = pttab_child(1:nbdim) + nbtab_child(1:nbdim) + ibeg + indtab(1:nbdim,2,2) = indtab(1:nbdim,2,1) + ( iend - ibeg ) + + indtab(1:nbdim,1,1) = pttab_child(1:nbdim) - iend + indtab(1:nbdim,1,2) = pttab_child(1:nbdim) - ibeg + + WHERE (posvartab_child(1:nbdim) == 2) + indtab(1:nbdim,1,1) = indtab(1:nbdim,1,1) - 1 + indtab(1:nbdim,1,2) = indtab(1:nbdim,1,2) - 1 + END WHERE +! + call Agrif_get_var_global_bounds(child,lubglob,nbdim) +! + indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1), lubglob(1:nbdim,1)) + indtruetab(1:nbdim,1,2) = max(indtab(1:nbdim,1,2), lubglob(1:nbdim,1)) + indtruetab(1:nbdim,2,1) = min(indtab(1:nbdim,2,1), lubglob(1:nbdim,2)) + indtruetab(1:nbdim,2,2) = min(indtab(1:nbdim,2,2), lubglob(1:nbdim,2)) +! + do nb = 1,nbdim + do ndir = 1,2 +! + if (loctab_child(nb) /= (-ndir) .AND. loctab_child(nb) /= -3) then +! + do n = 1,2 + ptres(nb,n,ndir,nb) = indtruetab(nb,ndir,n) + enddo +! + do i = 1,nbdim +! + if (i /= nb) then +! + if (loctab_child(i) == -1 .OR. loctab_child(i) == -3) then + ptres(i,1,ndir,nb) = pttab_child(i) + else + ptres(i,1,ndir,nb) = indtruetab(i,1,1) + endif + if (loctab_child(i) == -2 .OR. loctab_child(i) == -3) then + if (posvartab_child(i) == 1) then + ptres(i,2,ndir,nb) = pttab_child(i) + nbtab_child(i) + else + ptres(i,2,ndir,nb) = pttab_child(i) + nbtab_child(i) - 1 + endif + else + ptres(i,2,ndir,nb) = indtruetab(i,2,2) + endif +! + endif +! + enddo + +! +#if defined AGRIF_MPI + call Agrif_get_var_bounds_array(child,lower,upper,nbdim) + + do i = 1,nbdim +! + Call Agrif_GetLocalBoundaries(ptres(i,1,ndir,nb), ptres(i,2,ndir,nb), & + coords(i), lower(i), upper(i), ltab(i), utab(i) ) + ptres2(i,1,ndir,nb) = max(ltab(i),lower(i)) + ptres2(i,2,ndir,nb) = min(utab(i),upper(i)) + if ((i == nb) .AND. (ndir == 1)) then + ptres2(i,2,ndir,nb) = max(utab(i),lower(i)) + elseif ((i == nb) .AND. (ndir == 2)) then + ptres2(i,1,ndir,nb) = min(ltab(i),upper(i)) + endif +! + enddo +#else + ptres2(:,:,ndir,nb) = ptres(:,:,ndir,nb) +#endif + endif +! + enddo ! ndir = 1,2 + enddo ! nb = 1,nbdim +! + if ( child % interpIndex /= Agrif_Curgrid % parent % ngridstep .OR. & + child % Interpolationshouldbemade ) then +! +! Space interpolation +! + kindex = 1 +! + do nb = 1,nbdim + + type_interp = type_interp_bc(nb,:) + + do ndir = 1,2 +! + if (loctab_child(nb) /= (-ndir) .AND. loctab_child(nb) /= -3) then +! + call Agrif_InterpnD(type_interp, parent, child, & + ptres(1:nbdim,1,ndir,nb), & + ptres(1:nbdim,2,ndir,nb), & + pttab_child(1:nbdim), & + pttab_Parent(1:nbdim), & + s_Child(1:nbdim), s_Parent(1:nbdim), & + ds_Child(1:nbdim),ds_Parent(1:nbdim), & + NULL(), .FALSE., nbdim, & + childarray, & + child%memberin(nb,ndir), .TRUE., procname, coords(nb), ndir) + + child % childarray(1:nbdim,:,:,nb,ndir) = childarray + + if (.not. child%interpolationshouldbemade) then +! +! Safeguard of the values of the grid variable (at times n and n+1 on the parent grid) +! + sizetab = 1 + do i = 1,nbdim + sizetab = sizetab * (ptres2(i,2,ndir,nb)-ptres2(i,1,ndir,nb)+1) + enddo + + call saveAfterInterp(child,ptres2(:,:,ndir,nb),kindex,sizetab,nbdim) +! + endif +! + endif +! + enddo ! ndir = 1,2 + enddo ! nb = 1,nbdim +! + child % interpIndex = Agrif_Curgrid % parent % ngridstep +! + endif +! + if (.not. child%interpolationshouldbemade) then +! +! Calculation of the coefficients c1t and c2t for the temporary interpolation +! + if (pweight) then + c1t = weight + else + c1t = (REAL(Agrif_Nbstepint()) + 1.) / Agrif_Rhot() + endif + c2t = 1. - c1t +! +! Time interpolation +! + kindex = 1 +! + do nb = 1,nbdim + do ndir = 1,2 + if (loctab_child(nb) /= (-ndir) .AND. loctab_child(nb) /= -3) then + Call timeInterpolation(child,ptres2(:,:,ndir,nb),kindex,c1t,c2t,nbdim) + endif + enddo + enddo +! + endif +! + do nb = 1,nbdim + do ndir = 1,2 + if ( (loctab_child(nb) /= (-ndir)) .AND. (loctab_child(nb) /= -3) .AND. child%memberin(nb,ndir) ) then + select case(nbdim) + case(1) + i1 = child % childarray(1,1,2,nb,ndir) + i2 = child % childarray(1,2,2,nb,ndir) + + call procname(parray1(i1:i2), & + i1,i2, .FALSE.,coords(nb),ndir) + case(2) + i1 = child % childarray(1,1,2,nb,ndir) + i2 = child % childarray(1,2,2,nb,ndir) + j1 = child % childarray(2,1,2,nb,ndir) + j2 = child % childarray(2,2,2,nb,ndir) + + call procname(parray2(i1:i2,j1:j2), & + i1,i2,j1,j2, .FALSE.,coords(nb),ndir) + case(3) + i1 = child % childarray(1,1,2,nb,ndir) + i2 = child % childarray(1,2,2,nb,ndir) + j1 = child % childarray(2,1,2,nb,ndir) + j2 = child % childarray(2,2,2,nb,ndir) + k1 = child % childarray(3,1,2,nb,ndir) + k2 = child % childarray(3,2,2,nb,ndir) + + call procname(parray3(i1:i2,j1:j2,k1:k2), & + i1,i2,j1,j2,k1,k2, .FALSE.,coords(nb),ndir) + case(4) + i1 = child % childarray(1,1,2,nb,ndir) + i2 = child % childarray(1,2,2,nb,ndir) + j1 = child % childarray(2,1,2,nb,ndir) + j2 = child % childarray(2,2,2,nb,ndir) + k1 = child % childarray(3,1,2,nb,ndir) + k2 = child % childarray(3,2,2,nb,ndir) + l1 = child % childarray(4,1,2,nb,ndir) + l2 = child % childarray(4,2,2,nb,ndir) + + call procname(parray4(i1:i2,j1:j2,k1:k2,l1:l2), & + i1,i2,j1,j2,k1,k2,l1,l2, .FALSE.,coords(nb),ndir) + case(5) + i1 = child % childarray(1,1,2,nb,ndir) + i2 = child % childarray(1,2,2,nb,ndir) + j1 = child % childarray(2,1,2,nb,ndir) + j2 = child % childarray(2,2,2,nb,ndir) + k1 = child % childarray(3,1,2,nb,ndir) + k2 = child % childarray(3,2,2,nb,ndir) + l1 = child % childarray(4,1,2,nb,ndir) + l2 = child % childarray(4,2,2,nb,ndir) + m1 = child % childarray(5,1,2,nb,ndir) + m2 = child % childarray(5,2,2,nb,ndir) + + call procname(parray5(i1:i2,j1:j2,k1:k2,l1:l2,m1:m2), & + i1,i2,j1,j2,k1,k2,l1,l2,m1,m2, .FALSE.,coords(nb),ndir) + case(6) + i1 = child % childarray(1,1,2,nb,ndir) + i2 = child % childarray(1,2,2,nb,ndir) + j1 = child % childarray(2,1,2,nb,ndir) + j2 = child % childarray(2,2,2,nb,ndir) + k1 = child % childarray(3,1,2,nb,ndir) + k2 = child % childarray(3,2,2,nb,ndir) + l1 = child % childarray(4,1,2,nb,ndir) + l2 = child % childarray(4,2,2,nb,ndir) + m1 = child % childarray(5,1,2,nb,ndir) + m2 = child % childarray(5,2,2,nb,ndir) + n1 = child % childarray(6,1,2,nb,ndir) + n2 = child % childarray(6,2,2,nb,ndir) + + call procname(parray6(i1:i2,j1:j2,k1:k2,l1:l2,m1:m2,n1:n2), & + i1,i2,j1,j2,k1,k2,l1,l2,m1,m2,n1,n2, .FALSE.,coords(nb),ndir) + end select + endif + enddo + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Correctnd +!=================================================================================================== +! +!=================================================================================================== +! subroutine saveAfterInterp +! +!> saves the values of the grid variable on the fine grid after the space interpolation +!--------------------------------------------------------------------------------------------------- +subroutine saveAfterInterp ( child_var, bounds, kindex, newsize, nbdim ) +!--------------------------------------------------------------------------------------------------- + TYPE (Agrif_Variable), INTENT(inout) :: child_var !< The fine grid variable + INTEGER, DIMENSION(nbdim,2), INTENT(in) :: bounds + INTEGER, INTENT(inout) :: kindex !< Index indicating where this safeguard + !< is done on the fine grid + INTEGER, INTENT(in) :: newsize + INTEGER, INTENT(in) :: nbdim +! + INTEGER :: ir,jr,kr,lr,mr,nr +! +! Allocation of the array oldvalues2d +! + if (newsize .LE. 0) return +! + Call Agrif_Checksize(child_var,kindex+newsize) + + if (child_var % interpIndex /= Agrif_Curgrid % parent % ngridstep ) then + child_var % oldvalues2d(1,kindex:kindex+newsize-1) = & + child_var % oldvalues2d(2,kindex:kindex+newsize-1) + endif + + SELECT CASE (nbdim) + CASE (1) +!CDIR ALTCODE + do ir = bounds(1,1), bounds(1,2) + child_var % oldvalues2d(2,kindex) = parray1(ir) + kindex = kindex + 1 + enddo +! + CASE (2) + do jr = bounds(2,1),bounds(2,2) +!CDIR ALTCODE + do ir = bounds(1,1),bounds(1,2) + child_var % oldvalues2d(2,kindex) = parray2(ir,jr) + kindex = kindex + 1 + enddo + enddo +! + CASE (3) + do kr = bounds(3,1),bounds(3,2) + do jr = bounds(2,1),bounds(2,2) +!CDIR ALTCODE + do ir = bounds(1,1),bounds(1,2) + child_var % oldvalues2d(2,kindex) = parray3(ir,jr,kr) + kindex = kindex + 1 + enddo + enddo + enddo +! + CASE (4) + do lr = bounds(4,1),bounds(4,2) + do kr = bounds(3,1),bounds(3,2) + do jr = bounds(2,1),bounds(2,2) +!CDIR ALTCODE + do ir = bounds(1,1),bounds(1,2) + child_var % oldvalues2d(2,kindex) = parray4(ir,jr,kr,lr) + kindex = kindex + 1 + enddo + enddo + enddo + enddo +! + CASE (5) + do mr = bounds(5,1),bounds(5,2) + do lr = bounds(4,1),bounds(4,2) + do kr = bounds(3,1),bounds(3,2) + do jr = bounds(2,1),bounds(2,2) +!CDIR ALTCODE + do ir = bounds(1,1),bounds(1,2) + child_var % oldvalues2d(2,kindex) = parray5(ir,jr,kr,lr,mr) + kindex = kindex + 1 + enddo + enddo + enddo + enddo + enddo +! + CASE (6) + do nr = bounds(6,1),bounds(6,2) + do mr = bounds(5,1),bounds(5,2) + do lr = bounds(4,1),bounds(4,2) + do kr = bounds(3,1),bounds(3,2) + do jr = bounds(2,1),bounds(2,2) +!CDIR ALTCODE + do ir = bounds(1,1),bounds(1,2) + child_var % oldvalues2d(2,kindex) = parray6(ir,jr,kr,lr,mr,nr) + kindex = kindex + 1 + enddo + enddo + enddo + enddo + enddo + enddo + END SELECT +!--------------------------------------------------------------------------------------------------- +end subroutine saveAfterInterp +!=================================================================================================== +! +!=================================================================================================== +! subroutine timeInterpolation +! +!> subroutine for a linear time interpolation on the child grid +!--------------------------------------------------------------------------------------------------- +subroutine timeInterpolation ( child_var, bounds, kindex, c1t, c2t, nbdim ) +!--------------------------------------------------------------------------------------------------- + TYPE (Agrif_Variable) :: child_var !< The fine grid variable + INTEGER, DIMENSION(nbdim,2) :: bounds + INTEGER :: kindex !< Index indicating the values of the fine grid got + !< before and after the space interpolation and + !< used for the time interpolation + REAL :: c1t, c2t !< Coefficients for the time interpolation (c2t=1-c1t) + INTEGER :: nbdim +! + INTEGER :: ir,jr,kr,lr,mr,nr +! + SELECT CASE (nbdim) + CASE (1) +!CDIR ALTCODE + do ir = bounds(1,1),bounds(1,2) + parray1(ir) = c2t*child_var % oldvalues2d(1,kindex) + & + c1t*child_var % oldvalues2d(2,kindex) + kindex = kindex + 1 + enddo +! + CASE (2) + do jr = bounds(2,1),bounds(2,2) +!CDIR ALTCODE + do ir = bounds(1,1),bounds(1,2) + parray2(ir,jr) = c2t*child_var % oldvalues2d(1,kindex) + & + c1t*child_var % oldvalues2d(2,kindex) + kindex = kindex + 1 + enddo + enddo +! + CASE (3) + do kr = bounds(3,1),bounds(3,2) + do jr = bounds(2,1),bounds(2,2) +!CDIR ALTCODE + do ir = bounds(1,1),bounds(1,2) + parray3(ir,jr,kr) = c2t*child_var % oldvalues2d(1,kindex) + & + c1t*child_var % oldvalues2d(2,kindex) + kindex = kindex + 1 + enddo + enddo + enddo +! + CASE (4) + do lr = bounds(4,1),bounds(4,2) + do kr = bounds(3,1),bounds(3,2) + do jr = bounds(2,1),bounds(2,2) +!CDIR ALTCODE + do ir = bounds(1,1),bounds(1,2) + parray4(ir,jr,kr,lr) = c2t*child_var % oldvalues2d(1,kindex) + & + c1t*child_var % oldvalues2d(2,kindex) + kindex = kindex + 1 + enddo + enddo + enddo + enddo +! + CASE (5) + do mr=bounds(5,1),bounds(5,2) + do lr=bounds(4,1),bounds(4,2) + do kr=bounds(3,1),bounds(3,2) + do jr=bounds(2,1),bounds(2,2) +!CDIR ALTCODE + do ir=bounds(1,1),bounds(1,2) + parray5(ir,jr,kr,lr,mr) = c2t*child_var % oldvalues2d(1,kindex) + & + c1t*child_var % oldvalues2d(2,kindex) + kindex = kindex + 1 + enddo + enddo + enddo + enddo + enddo +! + CASE (6) + do nr=bounds(6,1),bounds(6,2) + do mr=bounds(5,1),bounds(5,2) + do lr=bounds(4,1),bounds(4,2) + do kr=bounds(3,1),bounds(3,2) + do jr=bounds(2,1),bounds(2,2) +!CDIR ALTCODE + do ir=bounds(1,1),bounds(1,2) + parray6(ir,jr,kr,lr,mr,nr) = c2t*child_var % oldvalues2d(1,kindex) + & + c1t*child_var % oldvalues2d(2,kindex) + kindex = kindex + 1 + enddo + enddo + enddo + enddo + enddo + enddo + END SELECT +!--------------------------------------------------------------------------------------------------- +end subroutine timeInterpolation +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Checksize +! +!> subroutine used in the saveAfterInterp procedure to allocate the oldvalues2d array +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Checksize ( child_var, newsize ) +!--------------------------------------------------------------------------------------------------- + TYPE (Agrif_Variable), INTENT(inout) :: child_var !< The fine grid variable + INTEGER , INTENT(in) :: newsize !< Size of the domains where the boundary + !< conditions are calculated +! + REAL, DIMENSION(:,:), Allocatable :: tempoldvalues ! Temporary array +! + if (.NOT. associated(child_var % oldvalues2d)) then +! + allocate(child_var % oldvalues2d(2,newsize)) + child_var % oldvalues2d = 0. +! + else +! + if (SIZE(child_var % oldvalues2d,2) < newsize) then +! + allocate(tempoldvalues(2,SIZE(child_var % oldvalues2d,2))) + tempoldvalues = child_var % oldvalues2d + deallocate(child_var % oldvalues2d) + allocate( child_var % oldvalues2d(2,newsize)) + child_var % oldvalues2d = 0. + child_var % oldvalues2d(:,1:SIZE(tempoldvalues,2)) = tempoldvalues(:,:) + deallocate(tempoldvalues) +! + endif +! + endif +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Checksize +!=================================================================================================== +! +end module Agrif_Boundary + diff --git a/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modbcfunction.F90 b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modbcfunction.F90 new file mode 100644 index 00000000..605b09a6 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modbcfunction.F90 @@ -0,0 +1,722 @@ +! +! $Id: modbcfunction.F 779 2007-12-22 17:04:17Z rblod $ +! +! AGRIF (Adaptive Grid Refinement In Fortran) +! +! Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr) +! Christophe Vouland (Christophe.Vouland@imag.fr) +! +! This program is free software; you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation; either version 2 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program; if not, write to the Free Software +! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +! +!> Module Agrif_BcFunction. +! +module Agrif_BcFunction +! +! Modules used: +! + use Agrif_Boundary + use Agrif_Update + use Agrif_Save +! + implicit none +! + interface Agrif_Set_Parent + module procedure Agrif_Set_Parent_int, & + Agrif_Set_Parent_real4, & + Agrif_Set_Parent_real8 + end interface +! + interface Agrif_Save_Forrestore + module procedure Agrif_Save_Forrestore0d, & + Agrif_Save_Forrestore2d, & + Agrif_Save_Forrestore3d, & + Agrif_Save_Forrestore4d + end interface +! +contains +! +!=================================================================================================== +! subroutine Agrif_Set_parent_int +! +!> To set the TYPE of the variable +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Set_parent_int(integer_variable,value) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: integer_variable !< indice of the variable in tabvars + integer, intent(in) :: value !< input value +! + +integer :: i +logical :: i_found + +i_found = .FALSE. + +do i=1,Agrif_NbVariables(4) + if (LOC(integer_variable) == LOC(agrif_curgrid%tabvars_i(i)%iarray0)) then + agrif_curgrid%tabvars_i(i)%parent_var%iarray0 = value + i_found = .TRUE. + EXIT + endif +enddo + +if (.NOT.i_found) STOP 'Agrif_Set_Integer : Variable not found' + +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Set_parent_int +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Set_parent_real4 +!--------------------------------------------------------------------------------------------------- +!> To set the parent value of a real variable +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Set_parent_real4 ( real_variable, value ) +!--------------------------------------------------------------------------------------------------- + real(kind=4), intent(in) :: real_variable !< input variable + real(kind=4),intent(in) :: value !< input value for the parent grid + +integer :: i +logical :: i_found + +i_found = .FALSE. + +do i=1,Agrif_NbVariables(2) + if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%array0)) then + agrif_curgrid%tabvars_r(i)%parent_var%array0 = value + agrif_curgrid%tabvars_r(i)%parent_var%sarray0 = value + i_found = .TRUE. + EXIT + endif +enddo + +IF (.NOT.i_found) THEN +do i=1,Agrif_NbVariables(2) + if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%sarray0)) then + agrif_curgrid%tabvars_r(i)%parent_var%array0 = value + agrif_curgrid%tabvars_r(i)%parent_var%sarray0 = value + i_found = .TRUE. + EXIT + endif +enddo +ENDIF + +if (.NOT.i_found) STOP 'Agrif_Set_parent_real4 : Variable not found' + +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Set_parent_real4 +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Set_parent_real8 +!--------------------------------------------------------------------------------------------------- +!> To set the parent value of a real variable +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Set_parent_real8 ( real_variable, value ) +!--------------------------------------------------------------------------------------------------- + real(kind=8), intent(in) :: real_variable !< input variable + real(kind=8),intent(in) :: value !< input value for the parent grid + +integer :: i +logical :: i_found + +i_found = .FALSE. + +do i=1,Agrif_NbVariables(2) + if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%array0)) then + agrif_curgrid%tabvars_r(i)%parent_var%darray0 = value + agrif_curgrid%tabvars_r(i)%parent_var%array0 = value + i_found = .TRUE. + EXIT + endif +enddo + +IF (.NOT.i_found) THEN +do i=1,Agrif_NbVariables(2) + if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%darray0)) then + agrif_curgrid%tabvars_r(i)%parent_var%darray0 = value + agrif_curgrid%tabvars_r(i)%parent_var%array0 = value + i_found = .TRUE. + EXIT + endif +enddo +ENDIF + +if (.NOT.i_found) STOP 'Agrif_Set_parent_real8 : Variable not found' + +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Set_parent_real8 +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Set_bc +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Set_bc ( tabvarsindic, bcinfsup, Interpolationshouldbemade ) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: tabvarsindic !< indice of the variable in tabvars + integer, dimension(2), intent(in) :: bcinfsup !< bcinfsup + logical, optional, intent(in) :: Interpolationshouldbemade !< interpolation should be made +! + integer :: indic ! indice of the variable in tabvars + type(Agrif_Variable), pointer :: var +! + var => Agrif_Search_Variable(Agrif_Curgrid,tabvarsindic) + if (.not.associated(var)) return ! Grand mother grid case +! + if ( Agrif_Curgrid % fixedrank /= 0 ) then + if ( .not.associated(var % oldvalues2D) ) then + allocate(var % oldvalues2D(2,1)) + var % interpIndex = -1 + var % oldvalues2D = 0. + endif + if ( present(Interpolationshouldbemade) ) then + var % Interpolationshouldbemade = Interpolationshouldbemade + endif + endif +! + var % bcinf = bcinfsup(1) + var % bcsup = bcinfsup(2) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Set_bc +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Set_interp +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Set_interp ( tabvarsindic, interp, interp1, interp2, interp3 , interp4) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: tabvarsindic !< indice of the variable in tabvars + integer, optional, intent(in) :: interp, interp1, interp2, interp3, interp4 +! + integer :: indic ! indice of the variable in tabvars + type(Agrif_Variable), pointer :: var +! + var => Agrif_Search_Variable(Agrif_Curgrid,tabvarsindic) + if (.not.associated(var)) return ! Grand mother grid case +! + var % type_interp = Agrif_Constant +! + if (present(interp)) var % type_interp = interp + if (present(interp1)) var % type_interp(1) = interp1 + if (present(interp2)) var % type_interp(2) = interp2 + if (present(interp3)) var % type_interp(3) = interp3 + if (present(interp4)) var % type_interp(4) = interp4 +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Set_interp +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Set_bcinterp +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Set_bcinterp ( tabvarsindic, interp, interp1, interp2, interp3, interp4, & + interp11, interp12, interp21, interp22 ) +!--------------------------------------------------------------------------------------------------- + INTEGER, intent(in) :: tabvarsindic !< indice of the variable in tabvars + INTEGER, OPTIONAL, intent(in) :: interp, interp1, interp2, interp3, interp4 + INTEGER, OPTIONAL, intent(in) :: interp11, interp12, interp21, interp22 +! + INTEGER :: indic ! indice of the variable in tabvars + TYPE(Agrif_Variable), pointer :: var +! + var => Agrif_Search_Variable(Agrif_Curgrid,tabvarsindic) +! + var % type_interp_bc = Agrif_Constant +! + if (present(interp)) var % type_interp_bc = interp + if (present(interp1)) var % type_interp_bc(:,1) = interp1 + if (present(interp11)) var % type_interp_bc(1,1) = interp11 + if (present(interp12)) var % type_interp_bc(1,2) = interp12 + if (present(interp2)) var % type_interp_bc(:,2) = interp2 + if (present(interp21)) var % type_interp_bc(2,1) = interp21 + if (present(interp22)) var % type_interp_bc(2,2) = interp22 + if (present(interp3)) var % type_interp_bc(:,3) = interp3 + if (present(interp4)) var % type_interp_bc(:,4) = interp4 +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Set_bcinterp +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Set_UpdateType +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Set_UpdateType ( tabvarsindic, update, update1, update2, & + update3, update4, update5 ) +!--------------------------------------------------------------------------------------------------- + INTEGER, intent(in) :: tabvarsindic !< indice of the variable in tabvars + INTEGER, OPTIONAL, intent(in) :: update, update1, update2, update3, update4, update5 +! + INTEGER :: indic ! indice of the variable in tabvars + type(Agrif_Variable), pointer :: root_var +! + + root_var => Agrif_Search_Variable(Agrif_Mygrid,tabvarsindic) + +! + root_var % type_update = Agrif_Update_Copy + if (present(update)) root_var % type_update = update + if (present(update1)) root_var % type_update(1) = update1 + if (present(update2)) root_var % type_update(2) = update2 + if (present(update3)) root_var % type_update(3) = update3 + if (present(update4)) root_var % type_update(4) = update4 + if (present(update5)) root_var % type_update(5) = update5 +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Set_UpdateType +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Set_restore +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Set_restore ( tabvarsindic ) +!--------------------------------------------------------------------------------------------------- + INTEGER, intent(in) :: tabvarsindic !< indice of the variable in tabvars +! + INTEGER :: indic ! indice of the variable in tabvars +! +print *,'CURRENTLY BROKEN' +STOP + + indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0 +! + Agrif_Mygrid%tabvars(indic) % restore = .TRUE. +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Set_restore +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Init_variable +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Init_variable ( tabvarsindic, procname ) +!--------------------------------------------------------------------------------------------------- + INTEGER, intent(in) :: tabvarsindic !< indice of the variable in tabvars + procedure() :: procname !< Data recovery procedure +! + if ( Agrif_Curgrid%level <= 0 ) return +! + call Agrif_Interp_variable(tabvarsindic, procname) + call Agrif_Bc_variable(tabvarsindic, procname, 1.) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Init_variable +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Bc_variable +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Bc_variable ( tabvarsindic, procname, calledweight ) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: tabvarsindic !< indice of the variable in tabvars + procedure() :: procname + real, optional, intent(in) :: calledweight +! + real :: weight + logical :: pweight + integer :: indic + integer :: nbdim + type(Agrif_Variable), pointer :: root_var + type(Agrif_Variable), pointer :: parent_var + type(Agrif_Variable), pointer :: child_var + type(Agrif_Variable), pointer :: child_tmp ! Temporary variable on the child grid + integer :: i + integer,dimension(7) :: lb, ub +! + if ( Agrif_Curgrid%level <= 0 ) return +! +! + if ( present(calledweight) ) then + weight = calledweight + pweight = .true. + else + weight = 0. + pweight = .false. + endif +! + child_var => Agrif_Search_Variable(Agrif_Curgrid,tabvarsindic) + parent_var => child_var % parent_var + root_var => child_var % root_var +! + nbdim = root_var % nbdim +! + do i=1,nbdim + if (root_var%coords(i) == 0) then + lb(i) = parent_var%lb(i) + ub(i) = parent_var%ub(i) + else + lb(i) = child_var%lb(i) + ub(i) = child_var%ub(i) + endif + enddo + + select case( nbdim ) + case(1) + allocate(parray1(lb(1):ub(1))) + case(2) + allocate(parray2(lb(1):ub(1), & + lb(2):ub(2) )) + case(3) + allocate(parray3(lb(1):ub(1), & + lb(2):ub(2), & + lb(3):ub(3) )) + case(4) + allocate(parray4(lb(1):ub(1), & + lb(2):ub(2), & + lb(3):ub(3), & + lb(4):ub(4) )) + case(5) + allocate(parray5(lb(1):ub(1), & + lb(2):ub(2), & + lb(3):ub(3), & + lb(4):ub(4), & + lb(5):ub(5) )) + case(6) + allocate(parray6(lb(1):ub(1), & + lb(2):ub(2), & + lb(3):ub(3), & + lb(4):ub(4), & + lb(5):ub(5), & + lb(6):ub(6) )) + end select +! +! Create temporary child variable + allocate(child_tmp) +! + child_tmp % root_var => root_var + child_tmp % oldvalues2D => child_var % oldvalues2D +! +! Index indicating if a space interpolation is necessary + child_tmp % interpIndex = child_var % interpIndex + child_tmp % list_interp => child_var % list_interp + child_tmp % Interpolationshouldbemade = child_var % Interpolationshouldbemade +! + child_tmp % point = child_var % point + child_tmp % lb = child_var % lb + child_tmp % ub = child_var % ub +! + child_tmp % bcinf = child_var % bcinf + child_tmp % bcsup = child_var % bcsup +! + child_tmp % childarray = child_var % childarray + child_tmp % memberin = child_var % memberin +! + call Agrif_CorrectVariable(parent_var, child_tmp, pweight, weight, procname) +! + child_var % childarray = child_tmp % childarray + child_var % memberin = child_tmp % memberin +! + child_var % oldvalues2D => child_tmp % oldvalues2D + child_var % list_interp => child_tmp % list_interp +! + child_var % interpIndex = child_tmp % interpIndex +! + deallocate(child_tmp) +! + select case( nbdim ) + case(1); deallocate(parray1) + case(2); deallocate(parray2) + case(3); deallocate(parray3) + case(4); deallocate(parray4) + case(5); deallocate(parray5) + case(6); deallocate(parray6) + end select +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Bc_variable +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Interp_variable +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Interp_variable ( tabvarsindic, procname ) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: tabvarsindic !< indice of the variable in tabvars + procedure() :: procname !< Data recovery procedure +! + integer :: nbdim + integer :: indic ! indice of the variable in tabvars + logical :: torestore + type(Agrif_Variable), pointer :: root_var + type(Agrif_Variable), pointer :: parent_var ! Variable on the parent grid + type(Agrif_Variable), pointer :: child_var ! Variable on the parent grid + type(Agrif_Variable), pointer :: child_tmp ! Temporary variable on the child grid +! + if ( Agrif_Curgrid%level <= 0 ) return +! + + child_var => Agrif_Search_Variable(Agrif_Curgrid,tabvarsindic) + parent_var => child_var % parent_var + root_var => child_var % root_var + +! + nbdim = root_var % nbdim + torestore = root_var % restore +! + allocate(child_tmp) +! + child_tmp % root_var => root_var + child_tmp % nbdim = root_var % nbdim + child_tmp % point = child_var % point + child_tmp % lb = child_var % lb + child_tmp % ub = child_var % ub + child_tmp % interpIndex = child_var % interpIndex + child_tmp % list_interp => child_var % list_interp + child_tmp % Interpolationshouldbemade = child_var % Interpolationshouldbemade +! + if ( torestore ) then + select case( nbdim ) + case(1) + parray1 = child_var % array1 + child_tmp % restore1D => child_var % restore1D + case(2) + parray2 = child_var % array2 + child_tmp % restore2D => child_var % restore2D + case(3) + parray3 = child_var % array3 + child_tmp % restore3D => child_var % restore3D + case(4) + parray4 = child_var % array4 + child_tmp % restore4D => child_var % restore4D + case(5) + parray5 = child_var % array5 + child_tmp % restore5D => child_var % restore5D + case(6) + parray6 = child_var % array6 + child_tmp % restore6D => child_var % restore6D + end select + endif +! + call Agrif_InterpVariable(parent_var, child_tmp, torestore, procname) +! + child_var % list_interp => child_tmp % list_interp +! + deallocate(child_tmp) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Interp_variable +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Update_Variable +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Update_Variable ( tabvarsindic, procname, & + locupdate, locupdate1, locupdate2, locupdate3, locupdate4 ) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: tabvarsindic !< Indice of the variable in tabvars + procedure() :: procname !< Data recovery procedure + integer, dimension(2), intent(in), optional :: locupdate + integer, dimension(2), intent(in), optional :: locupdate1 + integer, dimension(2), intent(in), optional :: locupdate2 + integer, dimension(2), intent(in), optional :: locupdate3 + integer, dimension(2), intent(in), optional :: locupdate4 +!--------------------------------------------------------------------------------------------------- + integer :: indic + integer :: nbdim + integer, dimension(6) :: updateinf ! First positions where interpolations are calculated + integer, dimension(6) :: updatesup ! Last positions where interpolations are calculated + type(Agrif_Variable), pointer :: root_var + type(Agrif_Variable), pointer :: parent_var + type(Agrif_Variable), pointer :: child_var +! + if ( Agrif_Root() .AND. (.not.agrif_coarse) ) return + if (agrif_curgrid%grand_mother_grid) return +! + + child_var => Agrif_Search_Variable(Agrif_Curgrid, tabvarsindic) + parent_var => child_var % parent_var + + if (.not.associated(parent_var)) then + ! can occur during the first update of Agrif_Coarsegrid (if any) + parent_var => Agrif_Search_Variable(Agrif_Curgrid % parent, tabvarsindic) + child_var % parent_var => parent_var + endif + + root_var => child_var % root_var + +! + nbdim = root_var % nbdim +! + updateinf = -99 + updatesup = -99 +! + if ( present(locupdate) ) then + updateinf(1:nbdim) = locupdate(1) + updatesup(1:nbdim) = locupdate(2) + endif +! + if ( present(locupdate1) ) then + updateinf(1) = locupdate1(1) + updatesup(1) = locupdate1(2) + endif +! + if ( present(locupdate2) ) then + updateinf(2) = locupdate2(1) + updatesup(2) = locupdate2(2) + endif + + if ( present(locupdate3) ) then + updateinf(3) = locupdate3(1) + updatesup(3) = locupdate3(2) + endif + + if ( present(locupdate4) ) then + updateinf(4) = locupdate4(1) + updatesup(4) = locupdate4(2) + endif +! + call Agrif_UpdateVariable( parent_var, child_var, updateinf, updatesup, procname ) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Update_Variable +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Save_ForRestore0D +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Save_ForRestore0D ( tabvarsindic0, tabvarsindic ) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: tabvarsindic0, tabvarsindic +! + type(Agrif_Variable), pointer :: root_var, save_var + integer :: nbdim +! +print *,'CURRENTLY BROKEN' +STOP + root_var => Agrif_Mygrid % tabvars(tabvarsindic0) + save_var => Agrif_Curgrid % tabvars(tabvarsindic0) + nbdim = root_var % nbdim +! + select case(nbdim) + case(2); call Agrif_Save_ForRestore2D(save_var % array2, tabvarsindic) + case(3); call Agrif_Save_ForRestore3D(save_var % array3, tabvarsindic) + case(4); call Agrif_Save_ForRestore4D(save_var % array4, tabvarsindic) + end select +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Save_ForRestore0D +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Save_ForRestore2D +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Save_ForRestore2D ( q, tabvarsindic ) +!--------------------------------------------------------------------------------------------------- + real, dimension(:,:), intent(in) :: q + integer, intent(in) :: tabvarsindic +! + type(Agrif_Variable), pointer :: root_var, save_var + integer :: indic +! +print *,'CURRENTLY BROKEN' +STOP + indic = tabvarsindic + if (tabvarsindic >= 0) then + if (Agrif_Curgrid%tabvars_i(tabvarsindic)%nbdim == 0) then + indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0 + endif + endif +! + if (indic <= 0) then + save_var => Agrif_Search_Variable(Agrif_Curgrid,-indic) + root_var => Agrif_Search_Variable(Agrif_Mygrid,-indic) + else + save_var => Agrif_Curgrid % tabvars(indic) + root_var => Agrif_Mygrid % tabvars(indic) + endif +! + if ( .not.allocated(save_var%array2) ) then + allocate(save_var%array2(save_var%lb(1):save_var%ub(1), & + save_var%lb(2):save_var%ub(2))) + endif +! + save_var % array2 = q + root_var % restore = .true. +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Save_ForRestore2D +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Save_ForRestore3D +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Save_ForRestore3D ( q, tabvarsindic ) +!--------------------------------------------------------------------------------------------------- + real, dimension(:,:,:), intent(in) :: q + integer, intent(in) :: tabvarsindic +! + type(Agrif_Variable), pointer :: root_var, save_var + integer :: indic +! +print *,'CURRENTLY BROKEN' +STOP + + indic = tabvarsindic + if (tabvarsindic >= 0) then + if (Agrif_Curgrid%tabvars_i(tabvarsindic)%nbdim == 0) then + indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0 + endif + endif +! + if (indic <= 0) then + save_var => Agrif_Search_Variable(Agrif_Curgrid,-indic) + root_var => Agrif_Search_Variable(Agrif_Mygrid,-indic) + else + save_var => Agrif_Curgrid % tabvars(indic) + root_var => Agrif_Mygrid % tabvars(indic) + endif +! + if ( .not.allocated(save_var%array3) ) then + allocate(save_var%array3(save_var%lb(1):save_var%ub(1), & + save_var%lb(2):save_var%ub(2), & + save_var%lb(3):save_var%ub(3))) + endif +! + save_var % array3 = q + root_var % restore = .true. +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Save_ForRestore3D +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Save_ForRestore4D +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Save_ForRestore4D ( q, tabvarsindic ) +!--------------------------------------------------------------------------------------------------- + real, dimension(:,:,:,:), intent(in) :: q + integer, intent(in) :: tabvarsindic +! + type(Agrif_Variable), pointer :: root_var, save_var + integer :: indic +! +print *,'CURRENTLY BROKEN' +STOP + indic = tabvarsindic + if (tabvarsindic >= 0) then + if (Agrif_Curgrid%tabvars_i(tabvarsindic)%nbdim == 0) then + indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0 + endif + endif +! + if (indic <= 0) then + save_var => Agrif_Search_Variable(Agrif_Curgrid,-indic) + root_var => Agrif_Search_Variable(Agrif_Mygrid,-indic) + else + save_var => Agrif_Curgrid % tabvars(indic) + root_var => Agrif_Mygrid % tabvars(indic) + endif +! + if (.not.allocated(save_var%array4)) then + allocate(save_var%array4(save_var%lb(1):save_var%ub(1),& + save_var%lb(2):save_var%ub(2),& + save_var%lb(3):save_var%ub(3),& + save_var%lb(4):save_var%ub(4))) + endif +! + save_var % array4 = q + root_var % restore = .true. +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Save_ForRestore4D +!=================================================================================================== +! +end module Agrif_BcFunction diff --git a/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modcluster.F90 b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modcluster.F90 new file mode 100644 index 00000000..debe19f1 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modcluster.F90 @@ -0,0 +1,1277 @@ +! +! $Id: modcluster.F 662 2007-05-25 15:58:52Z opalod $ +! +! AGRIF (Adaptive Grid Refinement In Fortran) +! +! Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr) +! Christophe Vouland (Christophe.Vouland@imag.fr) +! +! This program is free software; you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation; either version 2 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program; if not, write to the Free Software +! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +! +! +!> Module Agrif_Clustering +!> +!> Contains subroutines to create and initialize the grid hierarchy from the +!> AGRIF_FixedGrids.in file. +! +module Agrif_Clustering +! + use Agrif_CurgridFunctions + use Agrif_Init_Vars + use Agrif_Save +! + implicit none +! + abstract interface + subroutine init_proc() + end subroutine init_proc + end interface +! +contains +! +!=================================================================================================== +! subroutine Agrif_Cluster_All +! +!> Subroutine for the clustering. A temporary grid hierarchy, pointed by parent_rect, is created. +!--------------------------------------------------------------------------------------------------- +recursive subroutine Agrif_Cluster_All ( g, parent_rect ) +!--------------------------------------------------------------------------------------------------- + TYPE(Agrif_Grid) , pointer :: g !< Pointer on the current grid + TYPE(Agrif_Rectangle), pointer :: parent_rect +! + TYPE(Agrif_LRectangle), pointer :: parcours + TYPE(Agrif_Grid) , pointer :: newgrid + REAL :: g_eps + INTEGER :: i +! + g_eps = huge(1.) + do i = 1,Agrif_Probdim + g_eps = min(g_eps, g % Agrif_dx(i)) + enddo +! + g_eps = g_eps / 100. +! +! Necessary condition for clustering + do i = 1,Agrif_Probdim + if ( g%Agrif_dx(i)/Agrif_coeffref(i) < (Agrif_mind(i)-g_eps)) return + enddo +! + nullify(parent_rect%childgrids) +! + call Agrif_ClusterGridnD(g,parent_rect) +! + parcours => parent_rect % childgrids +! + do while ( associated(parcours) ) +! +! Newgrid is created. It is a copy of a fine grid created previously by clustering. + allocate(newgrid) +! + do i = 1,Agrif_Probdim + newgrid % nb(i) = (parcours % r % imax(i) - parcours % r % imin(i)) * Agrif_Coeffref(i) + newgrid % Agrif_x(i) = g % Agrif_x(i) + (parcours % r % imin(i) -1) * g%Agrif_dx(i) + newgrid % Agrif_dx(i) = g % Agrif_dx(i) / Agrif_Coeffref(i) + enddo +! + if ( Agrif_Probdim == 1 ) then + allocate(newgrid%tabpoint1D(newgrid%nb(1)+1)) + newgrid%tabpoint1D = 0 + endif +! + if ( Agrif_Probdim == 2 ) then + allocate(newgrid%tabpoint2D(newgrid%nb(1)+1, newgrid%nb(2)+1)) + newgrid%tabpoint2D = 0 + endif +! + if ( Agrif_Probdim == 3 ) then + allocate(newgrid%tabpoint3D(newgrid%nb(1)+1, newgrid%nb(2)+1, newgrid%nb(3)+1)) + newgrid%tabpoint3D = 0 + endif +! +! Points detection on newgrid + call Agrif_TabpointsnD(Agrif_mygrid,newgrid) +! +! recursive call to Agrif_Cluster_All + call Agrif_Cluster_All(newgrid, parcours % r) +! + parcours => parcours % next +! + if ( Agrif_Probdim == 1 ) deallocate(newgrid%tabpoint1D) + if ( Agrif_Probdim == 2 ) deallocate(newgrid%tabpoint2D) + if ( Agrif_Probdim == 3 ) deallocate(newgrid%tabpoint3D) +! + deallocate(newgrid) +! + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Cluster_All +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_TabpointsnD +! +!> Copy on newgrid of points detected on the grid hierarchy pointed by g. +!--------------------------------------------------------------------------------------------------- +recursive subroutine Agrif_TabpointsnD ( g, newgrid ) +!--------------------------------------------------------------------------------------------------- + TYPE(Agrif_Grid), pointer :: g, newgrid +! + TYPE(Agrif_PGrid), pointer :: parcours +! + REAL :: g_eps, newgrid_eps, eps + REAL , DIMENSION(3) :: newmin, newmax + REAL , DIMENSION(3) :: gmin, gmax + REAL , DIMENSION(3) :: xmin + INTEGER, DIMENSION(3) :: igmin, inewmin + INTEGER, DIMENSION(3) :: inewmax + INTEGER :: i, j, k + INTEGER :: i0, j0, k0 +! + parcours => g % child_list % first +! + do while( associated(parcours) ) + call Agrif_TabpointsnD(parcours%gr,newgrid) + parcours => parcours % next + enddo +! + g_eps = 10. + newgrid_eps = 10. +! + do i = 1,Agrif_probdim + g_eps = min( g_eps , g % Agrif_dx(i) ) + newgrid_eps = min(newgrid_eps,newgrid%Agrif_dx(i)) + enddo +! + eps = min(g_eps,newgrid_eps)/100. +! + do i = 1,Agrif_probdim +! + if ( newgrid%Agrif_dx(i) < (g%Agrif_dx(i)-eps) ) return +! + gmin(i) = g%Agrif_x(i) + gmax(i) = g%Agrif_x(i) + g%nb(i) * g%Agrif_dx(i) +! + newmin(i) = newgrid%Agrif_x(i) + newmax(i) = newgrid%Agrif_x(i) + newgrid%nb(i) * newgrid%Agrif_dx(i) +! + if (gmax(i) < newmin(i)) return + if (gmin(i) > newmax(i)) return +! + inewmin(i) = 1 - floor(-(max(gmin(i),newmin(i))-newmin(i)) / newgrid%Agrif_dx(i)) +! + xmin(i) = newgrid%Agrif_x(i) + (inewmin(i)-1)*newgrid%Agrif_dx(i) +! + igmin(i) = 1 + nint((xmin(i)-gmin(i))/g%Agrif_dx(i)) +! + inewmax(i) = 1 + int( (min(gmax(i),newmax(i))-newmin(i)) / newgrid%Agrif_dx(i)) +! + enddo +! + if ( Agrif_probdim == 1 ) then + i0 = igmin(1) + do i = inewmin(1),inewmax(1) + newgrid%tabpoint1D(i) = max( newgrid%tabpoint1D(i), g%tabpoint1D(i0) ) + enddo + i0 = i0 + int(newgrid%Agrif_dx(1)/g%Agrif_dx(1)) + endif +! + if ( Agrif_probdim == 2 ) then + i0 = igmin(1) + do i = inewmin(1),inewmax(1) + j0 = igmin(2) + do j = inewmin(2),inewmax(2) + newgrid%tabpoint2D(i,j) = max( newgrid%tabpoint2D(i,j), g%tabpoint2D(i0,j0) ) + j0 = j0 + int(newgrid%Agrif_dx(2)/g%Agrif_dx(2)) + enddo + i0 = i0 + int(newgrid%Agrif_dx(1)/g%Agrif_dx(1)) + enddo + endif +! + if ( Agrif_probdim == 3 ) then + i0 = igmin(1) + do i = inewmin(1),inewmax(1) + j0 = igmin(2) + do j = inewmin(2),inewmax(2) + k0 = igmin(3) + do k = inewmin(3),inewmax(3) + newgrid%tabpoint3D(i,j,k) = max( newgrid%tabpoint3D(i,j,k), g%tabpoint3D(i0,j0,k0)) + k0 = k0 + int(newgrid%Agrif_dx(3)/g%Agrif_dx(3)) + enddo + j0 = j0 + int(newgrid%Agrif_dx(2)/g%Agrif_dx(2)) + enddo + i0 = i0 + int(newgrid%Agrif_dx(1)/g%Agrif_dx(1)) + enddo + endif +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_TabpointsnD +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_ClusterGridnD +! +!> Clustering on the grid pointed by g. +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_ClusterGridnD ( g, parent_rect ) +!--------------------------------------------------------------------------------------------------- + TYPE(Agrif_Grid) , pointer :: g !< Pointer on the current grid + TYPE(Agrif_Rectangle), pointer :: parent_rect +! + TYPE(Agrif_Rectangle) :: newrect + TYPE(Agrif_Variable_i) :: newflag +! + INTEGER :: i,j,k + INTEGER, DIMENSION(3) :: sx + INTEGER :: bufferwidth,flagpoints + INTEGER :: n1,n2,m1,m2,o1,o2 +! + bufferwidth = int(Agrif_Minwidth/5.) +! + do i = 1,Agrif_probdim + sx(i) = g % nb(i) + 1 + enddo +! + if ( Agrif_probdim == 1 ) then + allocate(newflag%iarray1(sx(1))) + newflag%iarray1 = 0 + endif + if ( Agrif_probdim == 2 ) then + allocate(newflag%iarray2(sx(1),sx(2))) + newflag%iarray2 = 0 + endif + if ( Agrif_probdim == 3 ) then + allocate(newflag%iarray3(sx(1),sx(2),sx(3))) + newflag%iarray3 = 0 + endif +! + flagpoints = 0 +! + if ( bufferwidth>0 ) then +! + if ( Agrif_probdim == 1 ) then + do i = bufferwidth,sx(1)-bufferwidth+1 + if (g % tabpoint1D(i) == 1) then + m1 = i - bufferwidth + 1 + m2 = i + bufferwidth - 1 + flagpoints = flagpoints + 1 + newflag%iarray1(m1:m2) = 1 + endif + enddo + endif +! + if ( Agrif_probdim == 2 ) then + do i = bufferwidth,sx(1)-bufferwidth+1 + do j = bufferwidth,sx(2)-bufferwidth+1 + if (g % tabpoint2D(i,j) == 1) then + n1 = j - bufferwidth + 1 + n2 = j + bufferwidth - 1 + m1 = i - bufferwidth + 1 + m2 = i + bufferwidth - 1 + flagpoints = flagpoints + 1 + newflag%iarray2(m1:m2,n1:n2) = 1 + endif + enddo + enddo + endif +! + if ( Agrif_probdim == 3 ) then + do i = bufferwidth,sx(1)-bufferwidth+1 + do j = bufferwidth,sx(2)-bufferwidth+1 + do k = bufferwidth,sx(3)-bufferwidth+1 + if (g % tabpoint3D(i,j,k) == 1) then + o1 = k - bufferwidth + 1 + o2 = k + bufferwidth - 1 + n1 = j - bufferwidth + 1 + n2 = j + bufferwidth - 1 + m1 = i - bufferwidth + 1 + m2 = i + bufferwidth - 1 + flagpoints = flagpoints + 1 + newflag%iarray3(m1:m2,n1:n2,o1:o2) = 1 + endif + enddo + enddo + enddo + endif +! + else +! + flagpoints = 1 + if ( Agrif_probdim == 1 ) newflag%iarray1 = g % tabpoint1D + if ( Agrif_probdim == 2 ) newflag%iarray2 = g % tabpoint2D + if ( Agrif_probdim == 3 ) newflag%iarray3 = g % tabpoint3D +! + endif +! + if (flagpoints == 0) then + if ( Agrif_probdim == 1 ) deallocate(newflag%iarray1) + if ( Agrif_probdim == 2 ) deallocate(newflag%iarray2) + if ( Agrif_probdim == 3 ) deallocate(newflag%iarray3) + return + endif +! + do i = 1 , Agrif_probdim + newrect % imin(i) = 1 + newrect % imax(i) = sx(i) + enddo +! + call Agrif_Clusternd(newflag,parent_rect%childgrids,newrect) +! + if ( Agrif_probdim == 1 ) deallocate(newflag%iarray1) + if ( Agrif_probdim == 2 ) deallocate(newflag%iarray2) + if ( Agrif_probdim == 3 ) deallocate(newflag%iarray3) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_ClusterGridnD +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_ClusternD +! +!> Clustering on the grid pointed by oldB. +!--------------------------------------------------------------------------------------------------- +recursive subroutine Agrif_Clusternd ( flag, boxlib, oldB ) +!--------------------------------------------------------------------------------------------------- + TYPE(Agrif_Variable_i) :: flag + TYPE(Agrif_LRectangle), pointer :: boxlib + TYPE(Agrif_Rectangle) :: oldB +! + TYPE(Agrif_LRectangle),pointer :: tempbox,parcbox,parcbox2 + TYPE(Agrif_Rectangle) :: newB,newB2 + INTEGER :: i,j,k + INTEGER, DIMENSION(:), allocatable :: i_sig, j_sig, k_sig + INTEGER, DIMENSION(3) :: ipu,ipl + INTEGER, DIMENSION(3) :: istr,islice + REAL :: cureff, neweff + INTEGER :: ValMax,ValSum,TailleTab + INTEGER :: nbpoints,nbpointsflag + LOGICAL :: test +! + allocate( i_sig(oldB%imin(1):oldB%imax(1)) ) + if ( Agrif_probdim >= 2 ) allocate( j_sig(oldB%imin(2):oldB%imax(2)) ) + if ( Agrif_probdim == 3 ) allocate( k_sig(oldB%imin(3):oldB%imax(3)) ) +! + test = .FALSE. + do i = 1,Agrif_probdim + test = test .OR. ( (oldB%imax(i)-oldB%imin(i)+1) < Agrif_Minwidth) + enddo + if ( test ) return +! + if ( Agrif_probdim == 1 ) i_sig = flag%iarray1 + if ( Agrif_probdim == 2 ) then + do i = oldB%imin(1),oldB%imax(1) + i_sig(i) = SUM(flag%iarray2(i, oldB%imin(2):oldB%imax(2))) + enddo + do j = oldB%imin(2),oldB%imax(2) + j_sig(j) = SUM(flag%iarray2(oldB%imin(1):oldB%imax(1),j)) + enddo + endif + if ( Agrif_probdim == 3 ) then + do i = oldB%imin(1),oldB%imax(1) + i_sig(i) = SUM(flag%iarray3(i,oldB%imin(2):oldB%imax(2), & + oldB%imin(3):oldB%imax(3))) + enddo + do j = oldB%imin(2),oldB%imax(2) + j_sig(j) = SUM(flag%iarray3( oldB%imin(1):oldB%imax(1), j, & + oldB%imin(3):oldB%imax(3))) + enddo + do k = oldB%imin(3),oldB%imax(3) + k_sig(k) = SUM(flag%iarray3( oldB%imin(1):oldB%imax(1), & + oldB%imin(2):oldB%imax(2), k) ) + enddo + endif +! + do i = 1,Agrif_probdim + ipl(i) = oldB%imin(i) + ipu(i) = oldB%imax(i) + enddo +! + call Agrif_Clusterprune(i_sig,ipl(1),ipu(1)) + if ( Agrif_probdim >= 2 ) call Agrif_Clusterprune(j_sig,ipl(2),ipu(2)) + if ( Agrif_probdim == 3 ) call Agrif_Clusterprune(k_sig,ipl(3),ipu(3)) +! + test = .TRUE. + do i = 1,Agrif_probdim + test = test .AND. (ipl(i) == oldB%imin(i)) + test = test .AND. (ipu(i) == oldB%imax(i)) + enddo + + if (.NOT. test) then + do i = 1 , Agrif_probdim + newB%imin(i) = ipl(i) + newB%imax(i) = ipu(i) + enddo +! + if ( Agrif_probdim == 1 ) nbpoints = SUM(flag%iarray1(newB%imin(1):newB%imax(1))) + if ( Agrif_probdim == 2 ) nbpoints = SUM(flag%iarray2(newB%imin(1):newB%imax(1), & + newB%imin(2):newB%imax(2))) + if ( Agrif_probdim == 3 ) nbpoints = SUM(flag%iarray3(newB%imin(1):newB%imax(1), & + newB%imin(2):newB%imax(2), & + newB%imin(3):newB%imax(3))) +! + if ( Agrif_probdim == 1 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) + if ( Agrif_probdim == 2 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * & + (newB%imax(2)-newB%imin(2)+1) + if ( Agrif_probdim == 3 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * & + (newB%imax(2)-newB%imin(2)+1) * & + (newB%imax(3)-newB%imin(3)+1) + neweff = REAL(nbpoints) / TailleTab +! + if (nbpoints > 0) then +! + if ((neweff > Agrif_efficiency)) then + call Agrif_Add_Rectangle(newB,boxlib) + return + else +! + tempbox => boxlib + newB2 = newB + call Agrif_Clusternd(flag,boxlib,newB) +! +! Compute new efficiency + cureff = neweff + parcbox2 => boxlib + nbpoints = 0 + nbpointsflag = 0 +! + do while (associated(parcbox2)) + if (associated(parcbox2,tempbox)) exit + newB = parcbox2%r +! + if ( Agrif_probdim == 1 ) Valsum = SUM(flag%iarray1(newB%imin(1):newB%imax(1))) + if ( Agrif_probdim == 2 ) Valsum = SUM(flag%iarray2(newB%imin(1):newB%imax(1), & + newB%imin(2):newB%imax(2))) + if ( Agrif_probdim == 3 ) Valsum = SUM(flag%iarray3(newB%imin(1):newB%imax(1), & + newB%imin(2):newB%imax(2), & + newB%imin(3):newB%imax(3))) + nbpointsflag = nbpointsflag + ValSum +! + if ( Agrif_probdim == 1 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) + if ( Agrif_probdim == 2 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * & + (newB%imax(2)-newB%imin(2)+1) + if ( Agrif_probdim == 3 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * & + (newB%imax(2)-newB%imin(2)+1) * & + (newB%imax(3)-newB%imin(3)+1) + nbpoints = nbpoints + TailleTab + parcbox2 => parcbox2%next + enddo +! +! coefficient 1.05 avant 1.15 possibilite de laisser choix a l utilisateur + if ( REAL(nbpointsflag)/REAL(nbpoints) < (1.0001*cureff)) then + parcbox2 => boxlib + do while (associated(parcbox2)) + if (associated(parcbox2,tempbox)) exit + deallocate(parcbox2%r) + parcbox2 => parcbox2%next + enddo + boxlib => tempbox + call Agrif_Add_Rectangle(newB2,boxlib) + return + endif + endif + endif + return + endif +! + do i = 1,Agrif_Probdim + istr(i) = oldB%imax(i) + islice(i) = oldB%imin(i) + enddo +! + call Agrif_Clusterslice(i_sig,islice(1),istr(1)) + if ( Agrif_probdim >= 2 ) call Agrif_Clusterslice(j_sig,islice(2),istr(2)) + if ( Agrif_probdim == 3 ) call Agrif_Clusterslice(k_sig,islice(3),istr(3)) +! + ValSum = 0 + do i = 1,Agrif_Probdim + Valsum = valSum + islice(i) + enddo +! + if ( Valsum == -Agrif_Probdim ) then + call Agrif_Add_Rectangle(oldB,boxlib) + return + endif +! + nullify(tempbox) + tempbox => boxlib + if ( Agrif_probdim == 1 ) cureff = (oldB%imax(1)-oldB%imin(1)+1) + if ( Agrif_probdim == 2 ) cureff = (oldB%imax(1)-oldB%imin(1)+1) * & + (oldB%imax(2)-oldB%imin(2)+1) + if ( Agrif_probdim == 3 ) cureff = (oldB%imax(1)-oldB%imin(1)+1) * & + (oldB%imax(2)-oldB%imin(2)+1) * & + (oldB%imax(3)-oldB%imin(3)+1) + nullify(parcbox) +! + do i = 1,Agrif_Probdim + newB%imax(i) = oldB%imax(i) + newB%imin(i) = oldB%imin(i) + enddo +! + ValMax = 0 + do i = 1 , Agrif_Probdim + ValMax = Max(ValMax,istr(i)) + enddo +! + if (istr(1) == ValMax ) then + newB%imax(1) = islice(1) + call Agrif_Add_Rectangle(newB,parcbox) + newB%imin(1) = islice(1)+1 + newB%imax(1) = oldB%imax(1) + call Agrif_Add_Rectangle(newB,parcbox) + else if ( Agrif_probdim >= 2 ) then + if (istr(2) == ValMax ) then + newB%imax(2) = islice(2) + call Agrif_Add_Rectangle(newB,parcbox) + newB%imin(2) = islice(2)+1 + newB%imax(2) = oldB%imax(2) + call Agrif_Add_Rectangle(newB,parcbox) + else if ( Agrif_probdim == 3 ) then + newB%imax(3) = islice(3) + call Agrif_Add_Rectangle(newB,parcbox) + newB%imin(3) = islice(3)+1 + newB%imax(3) = oldB%imax(3) + call Agrif_Add_Rectangle(newB,parcbox) + endif + endif +! + do while ( associated(parcbox) ) + newB = parcbox%r +! + if ( Agrif_probdim == 1 ) nbpoints = SUM(flag%iarray1(newB%imin(1):newB%imax(1))) + if ( Agrif_probdim == 2 ) nbpoints = SUM(flag%iarray2(newB%imin(1):newB%imax(1), & + newB%imin(2):newB%imax(2))) + if ( Agrif_probdim == 3 ) nbpoints = SUM(flag%iarray3(newB%imin(1):newB%imax(1), & + newB%imin(2):newB%imax(2), & + newB%imin(3):newB%imax(3))) +! + if ( Agrif_probdim == 1 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) + if ( Agrif_probdim == 2 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * & + (newB%imax(2)-newB%imin(2)+1) + if ( Agrif_probdim == 3 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * & + (newB%imax(2)-newB%imin(2)+1) * & + (newB%imax(3)-newB%imin(3)+1) + neweff = REAL(nbpoints) / TailleTab +! + if ( nbpoints > 0 ) then +! + if ( (neweff > Agrif_efficiency)) then + call Agrif_Add_Rectangle(newB,boxlib) + else + tempbox => boxlib + newB2 = newB + call Agrif_Clusternd(flag,boxlib,newB) +! +! Compute new efficiency + cureff = neweff + parcbox2 => boxlib + nbpoints = 0 + nbpointsflag = 0 +! + do while (associated(parcbox2)) + if (associated(parcbox2,tempbox)) exit + newB = parcbox2%r +! + if ( Agrif_probdim == 1 ) ValSum = SUM(flag%iarray1(newB%imin(1):newB%imax(1))) + if ( Agrif_probdim == 2 ) ValSum = SUM(flag%iarray2(newB%imin(1):newB%imax(1), & + newB%imin(2):newB%imax(2))) + if ( Agrif_probdim == 3 ) ValSum = SUM(flag%iarray3(newB%imin(1):newB%imax(1), & + newB%imin(2):newB%imax(2), & + newB%imin(3):newB%imax(3))) + nbpointsflag = nbpointsflag + ValSum +! + if ( Agrif_probdim == 1 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) + if ( Agrif_probdim == 2 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * & + (newB%imax(2)-newB%imin(2)+1) + if ( Agrif_probdim == 3 ) TailleTab = (newB%imax(1)-newB%imin(1)+1) * & + (newB%imax(2)-newB%imin(2)+1) * & + (newB%imax(3)-newB%imin(3)+1) + nbpoints = nbpoints + TailleTab + parcbox2 => parcbox2%next + enddo +! + if ( REAL(nbpointsflag)/REAL(nbpoints) < (1.15*cureff)) then + parcbox2 => boxlib + do while (associated(parcbox2)) + if (associated(parcbox2,tempbox)) exit + deallocate(parcbox2%r) + parcbox2 => parcbox2%next + enddo + boxlib => tempbox + call Agrif_Add_Rectangle(newB2,boxlib) + endif + endif + endif + parcbox => parcbox%next + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Clusternd +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Clusterslice +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Clusterslice ( sig, slice, str ) +!--------------------------------------------------------------------------------------------------- + INTEGER, intent(inout) :: slice + INTEGER, intent(inout) :: str + INTEGER, DIMENSION(slice:str), intent(in) :: sig +! + INTEGER :: ideb, ifin + INTEGER :: i, t, a, di, ts + INTEGER, DIMENSION(slice:str) :: lap +! + ideb = slice + ifin = str +! + if (SIZE(sig) <= 2*Agrif_Minwidth) then + str = -1 + slice = -1 + return + endif +! + t = -1 + a = -1 +! + do i = ideb+Agrif_Minwidth-1,ifin-Agrif_Minwidth + if (sig(i) == 0) then + if ((i-ideb) < (ifin-i)) then + di = i - ideb + else + di = ifin - i + endif +! + if (di > t) then + a = i + t = di + endif + endif + enddo +! + if (a /= -1) then + slice = a + str = t + return + endif +! + t = -1 + a = -1 +! + do i = ideb+1,ifin-1 + lap(i) = sig(i+1) + sig(i-1) - 2*sig(i) + enddo +! + do i = ideb + Agrif_Minwidth-1,ifin-Agrif_Minwidth + if ((lap(i+1)*lap(i)) <= 0) then + ts = ABS(lap(i+1) - lap(i)) + if (ts > t) then + t = ts + a = i + endif + endif + enddo +! + if (a == (ideb + Agrif_Minwidth - 1)) then + a = -1 + t = -1 + endif +! + slice = a + str = t +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Clusterslice +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Clusterprune +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Clusterprune ( sig, pl, pu ) +!--------------------------------------------------------------------------------------------------- + INTEGER, intent(inout) :: pl, pu + INTEGER, DIMENSION(pl:pu), intent(in) :: sig +! + INTEGER :: ideb, ifin + INTEGER :: diff, addl, addu, udist, ldist +! + ideb = pl + ifin = pu +! + if (SIZE(sig) <= Agrif_Minwidth) return +! + do while ((sig(pl) == 0) .AND. (pl < ifin)) + pl = pl + 1 + enddo +! + do while ((sig(pu) == 0) .AND. (pu > ideb)) + pu = pu - 1 + enddo +! + if ( (pu-pl) < Agrif_Minwidth ) then + diff = Agrif_Minwidth - (pu - pl + 1) + udist = ifin - pu + ldist = pl - ideb + addl = diff / 2 + addu = diff - addl + if (addu > udist) then + addu = udist + addl = diff - addu + endif +! + if (addl > ldist) then + addl = ldist + addu = diff - addl + endif +! + pu = pu + addu + pl = pl - addl + endif +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Clusterprune +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Add_Rectangle +! +!> Adds the Agrif_Rectangle R in a list managed by LR. +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Add_Rectangle ( R, LR ) +!--------------------------------------------------------------------------------------------------- + TYPE(Agrif_Rectangle) :: R + TYPE(Agrif_LRectangle), pointer :: LR +! + TYPE(Agrif_LRectangle), pointer :: newrect +! + integer :: i +! + allocate(newrect) + allocate(newrect % r) +! + newrect % r = R +! + do i = 1,Agrif_Probdim + newrect % r % spaceref(i) = Agrif_Coeffref(i) + newrect % r % timeref(i) = Agrif_Coeffreft(i) + enddo +! + newrect % r % number = -1 + newrect % next => LR + LR => newrect +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Add_Rectangle +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Copy_Rectangle +! +!> Creates and returns a copy of Agrif_Rectangle R. +!--------------------------------------------------------------------------------------------------- +function Agrif_Copy_Rectangle ( R, expand ) result( copy ) +!--------------------------------------------------------------------------------------------------- + TYPE(Agrif_Rectangle), pointer, intent(in) :: R + integer, optional, intent(in) :: expand +! + TYPE(Agrif_Rectangle), pointer :: copy +! + allocate(copy) +! + copy = R + if ( present(expand) ) then + copy % imin = copy % imin - expand + copy % imax = copy % imax + expand + endif + copy % childgrids => R % childgrids +!--------------------------------------------------------------------------------------------------- +end function Agrif_Copy_Rectangle +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Read_Fix_Grd +! +!> Creates the grid hierarchy from the reading of the AGRIF_FixedGrids.in file. +!--------------------------------------------------------------------------------------------------- +recursive subroutine Agrif_Read_Fix_Grd ( parent_rect, j, nunit ) +!--------------------------------------------------------------------------------------------------- + TYPE(Agrif_Rectangle), pointer :: parent_rect !< Pointer on the first grid of the grid hierarchy + INTEGER :: j !< Number of the new grid + INTEGER :: nunit !< unit associated with file +! + TYPE(Agrif_Rectangle) :: newrect ! Pointer on a new grid + TYPE(Agrif_LRectangle), pointer :: parcours ! Pointer for the recursive procedure + TYPE(Agrif_LRectangle), pointer :: newlrect + TYPE(Agrif_LRectangle), pointer :: end_list + INTEGER :: i,n ! for each child grid + INTEGER :: nb_grids ! Number of child grids +! +! Reading of the number of child grids + read(nunit,*,end=99) nb_grids +! + allocate(end_list) +! + parent_rect % childgrids => end_list +! +! Reading of imin(1),imax(1),imin(2),imax(2),imin(3),imax(3), and space and +! time refinement factors for each child grid. +! Creation and addition of the new grid to the grid hierarchy. +! + do n = 1,nb_grids +! + allocate(newlrect) + newrect % number = j ! Number of the grid +! + if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) then + if (Agrif_Probdim == 3) then + read(nunit,*) newrect % imin(1), newrect % imax(1), & + newrect % imin(2), newrect % imax(2), & + newrect % imin(3), newrect % imax(3), & + newrect % spaceref(1), newrect % spaceref(2), newrect % spaceref(3), & + newrect % timeref(1), newrect % timeref(2), newrect % timeref(3) + elseif (Agrif_Probdim == 2) then + read(nunit,*) newrect % imin(1), newrect % imax(1), & + newrect % imin(2), newrect % imax(2), & + newrect % spaceref(1), newrect % spaceref(2), & + newrect % timeref(1), newrect % timeref(2) + elseif (Agrif_Probdim == 1) then + read(nunit,*) newrect % imin(1), newrect % imax(1), & + newrect % spaceref(1), & + newrect % timeref(1) + endif + else + if (Agrif_Probdim == 3) then + read(nunit,*) newrect % imin(1), newrect % imax(1), & + newrect % imin(2), newrect % imax(2), & + newrect % imin(3), newrect % imax(3), & + newrect % spaceref(1), newrect % spaceref(2), newrect % spaceref(3), & + newrect % timeref(1) + elseif (Agrif_Probdim == 2) then + read(nunit,*) newrect % imin(1), newrect % imax(1), & + newrect % imin(2), newrect % imax(2), & + newrect % spaceref(1), newrect % spaceref(2), & + newrect % timeref(1) + elseif (Agrif_Probdim == 1) then + read(nunit,*) newrect % imin(1), newrect % imax(1), & + newrect % spaceref(1), & + newrect % timeref(1) + endif +! + if ( Agrif_probdim >= 2 ) then + do i = 2,Agrif_probdim + newrect % timeref(i) = newrect % timeref(1) + enddo + endif +! + endif +! +! Addition to the grid hierarchy +! + j = j + 1 + allocate(newlrect%r) + newlrect % r = newrect + end_list % next => newlrect + end_list => end_list % next +! + enddo +! + parent_rect % childgrids => parent_rect % childgrids % next + parcours => parent_rect % childgrids +! +! recursive operation to create the grid hierarchy branch by branch +! + do while ( associated(parcours) ) + call Agrif_Read_Fix_Grd(parcours % r, j, nunit) + parcours => parcours % next + enddo +99 continue +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Read_Fix_Grd +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Create_Grids +! +!> Creates the grid hierarchy (g) from the one created with the #Agrif_Read_Fix_Grd or +!! #Agrif_Cluster_All procedures (parent_rect). +!--------------------------------------------------------------------------------------------------- +recursive subroutine Agrif_Create_Grids ( parent_grid, parent_rect ) +!--------------------------------------------------------------------------------------------------- + TYPE(Agrif_Grid) , pointer :: parent_grid !< Pointer on the root coarse grid + TYPE(Agrif_Rectangle), pointer :: parent_rect !< Pointer on the root coarse grid of the grid hierarchy + !! created with the #Agrif_Read_Fix_Grd subroutine +! + TYPE(Agrif_Grid) , pointer :: child_grid ! Newly created child grid + TYPE(Agrif_PGrid) , pointer :: child_grid_p + TYPE(Agrif_LRectangle), pointer :: child_rect_p + type(Agrif_Rectangle), pointer :: child_rect +! + INTEGER :: i + INTEGER, save :: moving_grid_id = 0 +! + child_rect_p => parent_rect % childgrids +! +! Creation of the grid hierarchy from the one created by using the Agrif_Read_Fix_Grd subroutine +! + do while ( associated(child_rect_p) ) +! + child_rect => child_rect_p % r +! + allocate(child_grid) +! +! Pointer on the parent grid + child_grid % parent => parent_grid + child_grid % rect_in_parent => Agrif_Copy_Rectangle(child_rect_p % r, expand=Agrif_Extra_Boundary_Cells) +! + moving_grid_id = moving_grid_id+1 + child_grid % grid_id = moving_grid_id +! + do i = 1,Agrif_Probdim + child_grid % spaceref(i) = child_rect % spaceref(i) + child_grid % timeref(i) = child_rect % timeref(i) + child_grid % nb(i) = (child_rect % imax(i) - child_rect % imin(i)) * child_rect % spaceref(i) + child_grid % ix(i) = child_rect % imin(i) + child_grid % Agrif_dt(i) = parent_grid % Agrif_dt(i) / REAL(child_grid % timeref(i)) + child_grid % Agrif_dx(i) = parent_grid % Agrif_dx(i) / REAL(child_grid % spaceref(i)) + child_grid % Agrif_x(i) = parent_grid % Agrif_x(i) + & + (child_rect % imin(i) - 1) * parent_grid % Agrif_dx(i) + enddo +! +! Size of the grid in terms of cpu cost (nx*ny*timeref) + child_grid % size = product( child_grid % nb(1:Agrif_Probdim) ) * child_grid % timeref(1) +! +! Level of the current grid + child_grid % level = child_grid % parent % level + 1 + if (child_grid % level > Agrif_MaxLevelLoc) then + Agrif_MaxLevelLoc = child_grid%level + endif +! +! Number of the grid pointed by child_grid + child_grid % fixedrank = child_rect % number +! +! Grid pointed by child_grid is a fixed grid + child_grid % fixed = ( child_grid % fixedrank > 0 ) +! +! Update the total number of fixed grids + if (child_grid % fixed) then + Agrif_nbfixedgrids = Agrif_nbfixedgrids + 1 + endif +! +! Initialize integration counter + child_grid % ngridstep = 0 +! +! Test indicating if the current grid has a common border with the root +! coarse grid in the x direction + do i = 1 , Agrif_Probdim +! + child_grid % NearRootBorder(i) = ( & + (child_grid % parent % NearRootBorder(i)) .AND. & + (child_grid % ix(i) == 1) ) +! + child_grid % DistantRootBorder(i) = ( & + (child_grid % parent % DistantRootBorder(i)) .AND. & + (child_grid % ix(i) + (child_grid%nb(i)/child_grid%spaceref(i))-1 == child_grid % parent % nb(i)) ) + enddo +! +! Writing in output files + child_grid % oldgrid = .FALSE. +! +#if defined AGRIF_MPI + child_grid % communicator = parent_grid % communicator +#endif +! +! Definition of the characteristics of the variable of the grid pointed by child_grid + call Agrif_Create_Var(child_grid) +! +! Addition of this grid to the grid hierarchy + call Agrif_gl_append( parent_grid % child_list, child_grid ) +! + child_rect_p => child_rect_p % next +! + enddo +! +! Recursive call to the subroutine Agrif_Create_Fixed_Grids to create the grid hierarchy +! + child_grid_p => parent_grid % child_list % first + child_rect_p => parent_rect % childgrids +! + do while ( associated(child_rect_p) ) + call Agrif_Create_Grids( child_grid_p % gr, child_rect_p % r ) + child_grid_p => child_grid_p % next + child_rect_p => child_rect_p % next + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Create_Grids +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Init_Hierarchy +! +!> Initializes all the grids except the root coarse grid (this one, pointed by Agrif_Types::Agrif_Mygrid, is +!! initialized by the subroutine Agrif_Util#Agrif_Init_Grids defined in the module Agrif_Util and +!! called in the main program). +!--------------------------------------------------------------------------------------------------- +recursive subroutine Agrif_Init_Hierarchy ( g, procname ) +!--------------------------------------------------------------------------------------------------- + use Agrif_seq +! + type(Agrif_Grid), pointer :: g !< Pointer on the current grid + procedure(init_proc), optional :: procname !< Initialisation subroutine (Default: Agrif_InitValues) +! + TYPE(Agrif_PGrid), pointer :: parcours ! Pointer for the recursive call + LOGICAL :: Init_Hierarchy +! +! Initialise the grand mother grid (if any) +! + if ( associated(g, Agrif_Mygrid) .and. agrif_coarse ) then + call Agrif_Instance(Agrif_Coarsegrid) + call Agrif_Allocation(Agrif_Coarsegrid) + call Agrif_initialisations(Agrif_Coarsegrid) + call Agrif_InitWorkspace() +! +! Initialization by interpolation (this routine is written by the user) + if (present(procname)) Then + call procname() + else + call Agrif_InitValues() + endif + call Agrif_Instance(Agrif_Mygrid) + endif + + parcours => g % child_list % first +! + do while ( associated(parcours) ) +! + Init_Hierarchy = .false. + if ( Agrif_USE_FIXED_GRIDS == 1 .OR. Agrif_USE_ONLY_FIXED_GRIDS == 1 ) then + if ( (parcours%gr%fixed) .AND. (Agrif_Mygrid%ngridstep == 0) ) then + Init_Hierarchy = .true. + endif + endif +! + if (.NOT. parcours % gr % fixed) Init_Hierarchy = .true. + if (parcours % gr % oldgrid) Init_Hierarchy = .false. +! + if (Init_Hierarchy) then +! +! Instanciation of the grid pointed by parcours%gr and its variables + call Agrif_Instance(parcours % gr) +! +! Allocation of the arrays containing values of the variables of the +! grid pointed by parcours%gr +! + call Agrif_Allocation(parcours % gr) + call Agrif_initialisations(parcours % gr) +! + if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) then +! Initialization by copy of the grids created by clustering + call Agrif_Allocate_Restore(parcours % gr) + call Agrif_CopyFromOld_All(parcours % gr, Agrif_oldmygrid) + endif +! +! Initialization by interpolation (this routine is written by the user) + call Agrif_InitWorkSpace() + if (present(procname)) Then + call procname() + else + call Agrif_InitValues() + endif +! + if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) then + call Agrif_Free_Restore(parcours % gr) + endif +! + endif +! + parcours => parcours % next +! + enddo +! + parcours => g % child_list % first +! +! recursive operation to initialize all the grids + do while ( associated(parcours) ) + call Agrif_Init_Hierarchy(parcours%gr,procname) + parcours => parcours%next + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Init_Hierarchy +!=================================================================================================== +! +#if defined AGRIF_MPI +!=================================================================================================== +! subroutine Agrif_Init_Hierarchy_Parallel_1 +!--------------------------------------------------------------------------------------------------- +recursive subroutine Agrif_Init_Hierarchy_Parallel_1 ( g ) +!--------------------------------------------------------------------------------------------------- + use Agrif_seq +! + type(Agrif_Grid), pointer :: g !< Pointer on the current grid +! + TYPE(Agrif_PGrid), pointer :: parcours ! Pointer for the recursive call + LOGICAL :: Init_Hierarchy +! + parcours => g % child_list % first +! + do while ( associated(parcours) ) +! + Init_Hierarchy = .false. + if ( Agrif_USE_FIXED_GRIDS == 1 .OR. Agrif_USE_ONLY_FIXED_GRIDS == 1 ) then + if ( (parcours%gr%fixed) .AND. (Agrif_Mygrid%ngridstep == 0) ) then + Init_Hierarchy = .true. + endif + endif +! + if (.NOT. parcours % gr % fixed) Init_Hierarchy = .true. + if (parcours % gr % oldgrid) Init_Hierarchy = .false. +! + if (Init_Hierarchy) then +! +! Instanciation of the grid pointed by parcours%gr and its variables + call Agrif_Instance(parcours % gr) +! +! Allocation of the arrays containing values of the variables of the +! grid pointed by parcours%gr +! + call Agrif_Allocation(parcours % gr) + call Agrif_initialisations(parcours % gr) +! + endif +! + parcours => parcours % next +! + enddo +! + parcours => g % child_list % first +! +! recursive operation to initialize all the grids + do while ( associated(parcours) ) + call Agrif_Init_Hierarchy_Parallel_1(parcours%gr) + parcours => parcours%next + enddo +! +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Init_Hierarchy_Parallel_1 +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Init_Hierarchy_Parallel_2 +!--------------------------------------------------------------------------------------------------- +recursive subroutine Agrif_Init_Hierarchy_Parallel_2 ( g, procname ) +!--------------------------------------------------------------------------------------------------- + use Agrif_seq +! + type(Agrif_Grid), pointer :: g !< Pointer on the current grid + procedure(init_proc), optional :: procname !< Initialisation subroutine (Default: Agrif_InitValues) +! + type(Agrif_PGrid), pointer :: parcours ! Pointer for the recursive call + integer :: is +! + call Agrif_Instance(g) + call Agrif_seq_init_sequences( g ) +! + if ( .not. associated(g % child_seq) ) return +! + do is = 1, g % child_seq % nb_seqs +! + parcours => Agrif_seq_select_child(g,is) +! +! Instanciation of the variables of the current grid + call Agrif_Instance(parcours % gr) +! +! Initialization by interpolation (this routine is written by the user) + if (present(procname)) Then + call procname() + else + call Agrif_InitValues() + endif +! + call Agrif_Init_ProcList(parcours % gr % proc_def_list, & + parcours % gr % proc_def_in_parent_list % nitems) +! + call Agrif_Init_Hierarchy_Parallel_2(parcours%gr,procname) +! + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Init_Hierarchy_Parallel_2 +!=================================================================================================== +#endif +! +!=================================================================================================== +! subroutine Agrif_Allocate_Restore +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Allocate_Restore ( Agrif_Gr ) +!--------------------------------------------------------------------------------------------------- + TYPE(Agrif_Grid), pointer :: Agrif_Gr !< Pointer on the root coarse grid +! + integer :: i +! + do i = 1,Agrif_NbVariables(0) +! + if ( Agrif_Mygrid%tabvars(i) % restore ) then + if ( Agrif_Gr%tabvars(i) % nbdim == 1 ) then + allocate( Agrif_Gr%tabvars(i)%Restore1D( & + lbound(Agrif_Gr%tabvars(i)%array1,1):& + ubound(Agrif_Gr%tabvars(i)%array1,1))) + Agrif_Gr%tabvars(i)%Restore1D = 0 + endif + if ( Agrif_Gr%tabvars(i) % nbdim == 2 ) then + allocate( Agrif_Gr%tabvars(i)%Restore2D( & + lbound(Agrif_Gr%tabvars(i)%array2,1):& + ubound(Agrif_Gr%tabvars(i)%array2,1),& + lbound(Agrif_Gr%tabvars(i)%array2,2):& + ubound(Agrif_Gr%tabvars(i)%array2,2))) + Agrif_Gr%tabvars(i)%Restore2D = 0 + endif + if ( Agrif_Mygrid%tabvars(i) % nbdim == 3 ) then + allocate( Agrif_Gr%tabvars(i)%Restore3D( & + lbound(Agrif_Gr%tabvars(i)%array3,1):& + ubound(Agrif_Gr%tabvars(i)%array3,1),& + lbound(Agrif_Gr%tabvars(i)%array3,2):& + ubound(Agrif_Gr%tabvars(i)%array3,2),& + lbound(Agrif_Gr%tabvars(i)%array3,3):& + ubound(Agrif_Gr%tabvars(i)%array3,3))) + Agrif_Gr%tabvars(i)%Restore3D = 0 + endif + endif +! + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Allocate_Restore +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Free_Restore +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Free_Restore ( Agrif_Gr ) +!--------------------------------------------------------------------------------------------------- + TYPE(Agrif_Grid), pointer :: Agrif_Gr !< Pointer on the root coarse grid +! + TYPE(Agrif_Variable), pointer :: var + integer :: i +! + do i = 1,Agrif_NbVariables(0) +! + if ( Agrif_Mygrid % tabvars(i) % restore ) then +! + var = Agrif_Gr % tabvars(i) +! + if (associated(var%Restore1D)) deallocate(var%Restore1D) + if (associated(var%Restore2D)) deallocate(var%Restore2D) + if (associated(var%Restore3D)) deallocate(var%Restore3D) + if (associated(var%Restore4D)) deallocate(var%Restore4D) + if (associated(var%Restore5D)) deallocate(var%Restore5D) + if (associated(var%Restore6D)) deallocate(var%Restore6D) +! + endif +! + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Free_Restore +!=================================================================================================== +! +end module Agrif_Clustering diff --git a/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modcurgridfunctions.F90 b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modcurgridfunctions.F90 new file mode 100644 index 00000000..83be5f77 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modcurgridfunctions.F90 @@ -0,0 +1,1019 @@ +! +! $Id: modcurgridfunctions.F 774 2007-12-18 16:45:53Z rblod $ +! +! AGRIF (Adaptive Grid Refinement In Fortran) +! +! Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr) +! Christophe Vouland (Christophe.Vouland@imag.fr) +! +! This program is free software; you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation; either version 2 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program; if not, write to the Free Software +! Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA. +! +!> Module to define some procedures concerning the current grid +! +module Agrif_CurgridFunctions +! + use Agrif_Init +! + implicit none +! + + interface Agrif_Parent + module procedure Agrif_Parent_Real_4, & + Agrif_Parent_Real_8, & + Agrif_Parent_Array2_Real_8, & + Agrif_Parent_Integer, & + Agrif_Parent_Character, & + Agrif_Parent_Logical + end interface + +contains +! +!=================================================================================================== +! function Agrif_rel_dt +! +!> Returns the time step of the current grid, relatively to the root grid (for which dt=1.). +!--------------------------------------------------------------------------------------------------- +function Agrif_rel_dt ( ) result( rel_dt ) +!--------------------------------------------------------------------------------------------------- + integer :: i + real :: rel_dt +! + rel_dt = 1. +! + do i = 1,Agrif_Probdim + rel_dt = min(rel_dt, Agrif_Curgrid % Agrif_dt(i)) + enddo +!--------------------------------------------------------------------------------------------------- +end function Agrif_rel_dt +!=================================================================================================== +! +!=================================================================================================== +! function Agrif_rel_idt +! +!> Returns the time refinement factor of the current grid, relatively to the root grid (for which idt=1). +!--------------------------------------------------------------------------------------------------- +function Agrif_rel_idt ( ) result( rel_idt ) +!--------------------------------------------------------------------------------------------------- + integer :: rel_idt +! + rel_idt = nint(1./Agrif_rel_dt()) +!--------------------------------------------------------------------------------------------------- +end function Agrif_rel_idt +!=================================================================================================== +! +!=================================================================================================== +! function Agrif_IRhot +! +!> Returns the time refinement factor of the current grid. +!--------------------------------------------------------------------------------------------------- +function Agrif_IRhot ( ) result( irhot ) +!--------------------------------------------------------------------------------------------------- + integer :: i, irhot +! + irhot = 1 +! + do i = 1,Agrif_Probdim + irhot = max(irhot, Agrif_Curgrid % timeref(i)) + enddo +!--------------------------------------------------------------------------------------------------- +end function Agrif_IRhot +!=================================================================================================== +! +!=================================================================================================== +! function Agrif_Rhot +! +!> Returns the time refinement factor of the current grid. +!--------------------------------------------------------------------------------------------------- +function Agrif_Rhot ( ) result( rhot ) +!--------------------------------------------------------------------------------------------------- + real :: rhot +! + rhot = float(Agrif_IRhot()) +!--------------------------------------------------------------------------------------------------- +end function Agrif_Rhot +!=================================================================================================== +! +!=================================================================================================== +! function Agrif_Parent_IRhot +! +!> Returns the time refinement factor of the parent of the current grid. +!--------------------------------------------------------------------------------------------------- +function Agrif_Parent_IRhot ( ) result( irhot ) +!--------------------------------------------------------------------------------------------------- + integer :: i, irhot +! + irhot = 1 +! + do i = 1,Agrif_Probdim + irhot = max(irhot, Agrif_Curgrid % parent % timeref(i)) + enddo +!--------------------------------------------------------------------------------------------------- +end function Agrif_Parent_IRhot +!=================================================================================================== +! +!=================================================================================================== +! function Agrif_Parent_Rhot +! +!> Returns the time refinement factor of the parent of the current grid. +!--------------------------------------------------------------------------------------------------- +function Agrif_Parent_Rhot ( ) result( rhot ) +!--------------------------------------------------------------------------------------------------- + real :: rhot +! + rhot = float(Agrif_Parent_IRhot()) +!--------------------------------------------------------------------------------------------------- +end function Agrif_Parent_Rhot +!=================================================================================================== +! +!=================================================================================================== +! function Agrif_Nbstepint +! +!> function for the calculation of the coefficients used for the time interpolation +!! (module #Agrif_Boundary). +!--------------------------------------------------------------------------------------------------- +function Agrif_Nbstepint ( ) +!--------------------------------------------------------------------------------------------------- + integer :: Agrif_nbstepint ! result +! + Agrif_nbstepint = mod(Agrif_Curgrid % ngridstep, Agrif_iRhot()) +!--------------------------------------------------------------------------------------------------- +end function Agrif_Nbstepint +!=================================================================================================== +! +!=================================================================================================== +! function Agrif_Parent_Nbstepint +! +!> function for the calculation of the coefficients used for the time interpolation +!! (module #Agrif_Boundary). +!--------------------------------------------------------------------------------------------------- +function Agrif_Parent_Nbstepint ( ) +!--------------------------------------------------------------------------------------------------- + integer :: Agrif_Parent_Nbstepint ! result +! + Agrif_Parent_Nbstepint = mod(Agrif_Curgrid % parent % ngridstep, int(Agrif_Parent_Rhot())) +!--------------------------------------------------------------------------------------------------- +end function Agrif_Parent_Nbstepint +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_InterpNearBorderX +! +!> Allows to interpolate (in the x direction) on a near border of the current grid if this one +!! has a common border with the root coarse grid. +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_InterpNearBorderX ( ) +!--------------------------------------------------------------------------------------------------- + Agrif_Curgrid % NearRootBorder(1) = .FALSE. +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_InterpNearBorderX +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_InterpDistantBorderX +! +!> Allows to interpolate (in the x direction) on a distant border of the current grid if this one +!! has a common border with the root coarse grid. +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_InterpDistantBorderX ( ) +!--------------------------------------------------------------------------------------------------- + Agrif_Curgrid % DistantRootBorder(1) = .FALSE. +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_InterpDistantBorderX +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_InterpNearBorderY +! +!> Allows to interpolate (in the y direction) on a near border of the current grid if this one +!! has a common border with the root coarse grid. +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_InterpNearBorderY ( ) +!--------------------------------------------------------------------------------------------------- + Agrif_Curgrid % NearRootBorder(2) = .FALSE. +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_InterpNearBorderY +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_InterpDistantBorderY +! +!> Allows to interpolate (in the y direction) on a distant border of the current grid if this one +!! has a common border with the root coarse grid. +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_InterpDistantBorderY ( ) +!--------------------------------------------------------------------------------------------------- + Agrif_Curgrid % DistantRootBorder(2) = .FALSE. +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_InterpDistantBorderY +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_InterpNearBorderZ +! +!> Allows to interpolate (in the z direction) on a near border of the current grid if this one +!! has a common border with the root coarse grid. +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_InterpNearBorderZ ( ) +!--------------------------------------------------------------------------------------------------- + Agrif_Curgrid % NearRootBorder(3) = .FALSE. +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_InterpNearBorderZ +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_InterpDistantBorderZ +! +!> Allows to interpolate (in the z direction) on a distant border of the current grid if this one +!! has a common border with the root coarse grid. +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_InterpDistantBorderZ() +!--------------------------------------------------------------------------------------------------- + Agrif_Curgrid % DistantRootBorder(3) = .FALSE. +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_InterpDistantBorderZ +!=================================================================================================== +! +!=================================================================================================== +! function Agrif_Parent_Nb_Step +! +!> Returns the number of time steps of the parent of the current grid. +!--------------------------------------------------------------------------------------------------- +function Agrif_Parent_Nb_Step ( ) +!--------------------------------------------------------------------------------------------------- + integer :: Agrif_Parent_Nb_Step ! Result +! + if (Agrif_Root()) then + Agrif_Parent_Nb_Step = -1 + else + Agrif_Parent_Nb_Step = Agrif_Curgrid % parent % ngridstep + endif +!--------------------------------------------------------------------------------------------------- +end function Agrif_Parent_Nb_Step +!=================================================================================================== +! +!=================================================================================================== +! function Agrif_Root +! +!> Indicates if the current grid is or not the root grid. +!--------------------------------------------------------------------------------------------------- +function Agrif_Root ( ) +!--------------------------------------------------------------------------------------------------- + logical :: Agrif_Root ! Result +! + Agrif_Root = (Agrif_Curgrid % fixedrank == 0) +!--------------------------------------------------------------------------------------------------- +end function Agrif_Root +!=================================================================================================== +! +!=================================================================================================== +! function Agrif_GrandMother +! +!> Indicates if the current grid is or not the root grid. +!--------------------------------------------------------------------------------------------------- +function Agrif_GrandMother ( ) +!--------------------------------------------------------------------------------------------------- + logical :: Agrif_GrandMother ! Result +! + Agrif_GrandMother = Agrif_Curgrid % grand_mother_grid +!--------------------------------------------------------------------------------------------------- +end function Agrif_GrandMother +!=================================================================================================== +! +!=================================================================================================== +! function Agrif_Parent_Root +! +!> Indicates if the parent of the current grid is or not the root grid. +!--------------------------------------------------------------------------------------------------- +function Agrif_Parent_Root ( ) +!--------------------------------------------------------------------------------------------------- + logical :: Agrif_Parent_Root ! Result +! + Agrif_Parent_Root = (Agrif_Curgrid % parent % fixedrank == 0) +!--------------------------------------------------------------------------------------------------- +end function Agrif_Parent_Root +!=================================================================================================== +! +!=================================================================================================== +! function Agrif_Fixed +! +!> Returns the number of the current grid. +!--------------------------------------------------------------------------------------------------- +function Agrif_Fixed ( ) +!--------------------------------------------------------------------------------------------------- + integer :: Agrif_Fixed ! Result +! + if (Agrif_Curgrid % fixed) then + Agrif_Fixed = Agrif_Curgrid % fixedrank + else + Agrif_Fixed = -1 + endif +!--------------------------------------------------------------------------------------------------- +end function Agrif_Fixed +!=================================================================================================== +! +!=================================================================================================== +! function Agrif_Parent_Fixed +! +!> Returns the number of the parent of the current grid. +!--------------------------------------------------------------------------------------------------- +function Agrif_Parent_Fixed ( ) +!--------------------------------------------------------------------------------------------------- + integer :: Agrif_Parent_Fixed ! Result +! + if (Agrif_Curgrid % parent % fixed) then + Agrif_Parent_Fixed = Agrif_Curgrid % parent % fixedrank + else + Agrif_Parent_Fixed = 0 + endif +!--------------------------------------------------------------------------------------------------- +end function Agrif_Parent_Fixed +!=================================================================================================== +! +!=================================================================================================== +! function Agrif_Is_Fixed +! +!> Returns .TRUE. if the current grid is fixed. +!--------------------------------------------------------------------------------------------------- +function Agrif_Is_Fixed ( ) +!--------------------------------------------------------------------------------------------------- + logical :: Agrif_Is_Fixed ! Result +! + Agrif_Is_Fixed = Agrif_Curgrid % fixed +!--------------------------------------------------------------------------------------------------- +end function Agrif_Is_Fixed +!=================================================================================================== +! +!=================================================================================================== +! function Agrif_Parent_Is_Fixed +! +!> Returns .TRUE. if the parent of the current grid is fixed. +!--------------------------------------------------------------------------------------------------- +function Agrif_Parent_Is_Fixed ( ) +!--------------------------------------------------------------------------------------------------- + logical :: Agrif_Parent_Is_Fixed ! Result +! + Agrif_Parent_Is_Fixed = Agrif_Curgrid % parent % fixed +!--------------------------------------------------------------------------------------------------- +end function Agrif_Parent_Is_Fixed +!=================================================================================================== +! +!=================================================================================================== +! function Agrif_CFixed +! +!> Returns the number of the current grid. +!--------------------------------------------------------------------------------------------------- +function Agrif_CFixed ( ) +!--------------------------------------------------------------------------------------------------- + character(3) :: Agrif_CFixed ! Result +! + character(3) :: cfixed + integer :: fixed +! + fixed = Agrif_Fixed() +! + if (fixed /= -1) then +! + if (fixed <= 9) then + write(cfixed,'(i1)') fixed + else + write(cfixed,'(i2)') fixed + endif +! + Agrif_CFixed = cfixed + + if (associated(agrif_curgrid,agrif_coarsegrid)) then + Agrif_CFixed = 'gm' + endif +! + else + print*,'Call to Agrif_CFixed() on a moving grid' + stop + endif +!--------------------------------------------------------------------------------------------------- +end function Agrif_CFixed +!=================================================================================================== +! +!=================================================================================================== +! function Agrid_Parent_CFixed +! +!> Returns the number of the parent of the current grid. +!--------------------------------------------------------------------------------------------------- +function Agrid_Parent_CFixed ( ) +!--------------------------------------------------------------------------------------------------- + character(3) :: Agrid_Parent_CFixed ! Result +! + character(3) :: cfixed + integer :: fixed +! + fixed = Agrif_Parent_Fixed() +! + if(fixed /= -1) then +! + if (fixed <= 9) then + write(cfixed,'(i1)')fixed + else + write(cfixed,'(i2)')fixed + endif +! + Agrid_Parent_CFixed=cfixed +! + else + print*,'Illegal call to Agrid_Parent_CFixed()' + stop + endif +!--------------------------------------------------------------------------------------------------- +end function Agrid_Parent_CFixed +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_ChildGrid_to_ParentGrid +! +!> Make the pointer #Agrif_Curgrid point on the parent grid of the current grid. +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_ChildGrid_to_ParentGrid ( ) +!--------------------------------------------------------------------------------------------------- + Agrif_Curgrid % parent % save_grid => Agrif_Curgrid + call Agrif_Instance(Agrif_Curgrid%parent) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_ChildGrid_to_ParentGrid +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_ParentGrid_to_ChildGrid +! +!> Make the pointer #Agrif_Curgrid point on the child grid after having called the +!! #Agrif_ChildGrid_to_ParentGrid subroutine. +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_ParentGrid_to_ChildGrid ( ) +!--------------------------------------------------------------------------------------------------- + call Agrif_Instance(Agrif_Curgrid%save_grid) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_ParentGrid_to_ChildGrid +!=================================================================================================== +! +!=================================================================================================== +! function Agrif_Get_Unit +! +!> Returns a unit not connected to any file. +!--------------------------------------------------------------------------------------------------- +function Agrif_Get_Unit ( ) +!--------------------------------------------------------------------------------------------------- + integer :: Agrif_Get_Unit ! Result +! + integer :: n + logical :: op +! + integer :: nunit + integer :: iii, out, iiimax + logical :: bexist + integer,dimension(1:1000) :: forbiddenunit +! +! Load forbidden Unit if the file Agrif_forbidenUnit exist +! + INQUIRE(file='Agrif_forbiddenUnit.txt', exist=bexist) +! + if (.not. bexist) then +! File Agrif_forbiddenUnit.txt not found + else + nunit = 777 + OPEN(nunit,file='Agrif_forbiddenUnit.txt', form='formatted', status="old") + iii = 1 + do while ( .TRUE. ) + READ(nunit,*, end=99) forbiddenunit(iii) + iii = iii + 1 + enddo + 99 continue + iiimax = iii + close(nunit) + endif +! + do n = 7,1000 +! + INQUIRE(Unit=n,Opened=op) +! + out = 0 + if ( bexist .AND. (.NOT.op) ) then + do iii = 1,iiimax + if ( n == forbiddenunit(iii) ) out = 1 + enddo + endif +! + if ( (.NOT.op) .AND. (out == 0) ) exit +! + enddo +! + Agrif_Get_Unit = n +!--------------------------------------------------------------------------------------------------- +end function Agrif_Get_Unit +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Set_Extra_Boundary_Cells +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Set_Extra_Boundary_Cells ( nb_extra_cells ) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: nb_extra_cells +! + Agrif_Extra_Boundary_Cells = nb_extra_cells +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Set_Extra_Boundary_Cells +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Set_Efficiency +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Set_Efficiency ( eff ) +!--------------------------------------------------------------------------------------------------- + real, intent(in) :: eff +! + if ( (eff < 0.) .OR. (eff > 1) ) then + write(*,*) 'Error Efficiency should be between 0 and 1' + stop + else + Agrif_Efficiency = eff + endif +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Set_Efficiency +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Set_Regridding +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Set_Regridding ( regfreq ) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: regfreq +! + if (regfreq < 0) then + write(*,*) 'Regridding frequency should be positive' + stop + else + Agrif_Regridding = regfreq + endif +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Set_Regridding +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Set_coeffref_x +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Set_coeffref_x ( coeffref ) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: coeffref + + if (coeffref < 0) then + write(*,*) 'Coefficient of raffinement should be positive' + stop + else + Agrif_coeffref(1) = coeffref + endif +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Set_coeffref_x +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Set_coeffref_y +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Set_coeffref_y ( coeffref ) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: coeffref + + if (coeffref < 0) then + write(*,*) 'Coefficient of raffinement should be positive' + stop + else + Agrif_coeffref(2) = coeffref + endif +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Set_coeffref_y +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Set_coeffref_z +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Set_coeffref_z ( coeffref ) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: coeffref +! + if (coeffref < 0) then + write(*,*) 'Coefficient of raffinement should be positive' + stop + else + Agrif_coeffref(3) = coeffref + endif +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Set_coeffref_z +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Set_coeffreft_x +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Set_coeffreft_x ( coeffref ) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: coeffref + + if (coeffref < 0) then + write(*,*) 'Coefficient of time raffinement should be positive' + stop + else + Agrif_coeffreft(1) = coeffref + endif +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Set_coeffreft_x +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Set_coeffreft_y +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Set_coeffreft_y ( coeffref ) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: coeffref +! + if (coeffref < 0) then + write(*,*) 'Coefficient of time raffinement should be positive' + stop + else + Agrif_coeffreft(2) = coeffref + endif +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Set_coeffreft_y +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Set_coeffreft_z +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Set_coeffreft_z ( coeffref ) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: coeffref + + if (coeffref < 0) then + write(*,*)'Coefficient of time raffinement should be positive' + stop + else + Agrif_coeffreft(3) = coeffref + endif +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Set_coeffreft_z +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Set_Minwidth +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Set_Minwidth ( coefminwidth ) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: coefminwidth +! + if (coefminwidth < 0) then + write(*,*)'Coefficient of Minwidth should be positive' + stop + else + Agrif_Minwidth = coefminwidth + endif +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Set_Minwidth +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Set_Rafmax +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Set_Rafmax ( coefrafmax ) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: coefrafmax +! + integer :: i + real :: res +! + if (coefrafmax < 0) then + write(*,*)'Coefficient of should be positive' + stop + else + res = 1. + do i = 1,coefrafmax-1 + res = res * FLOAT(Agrif_coeffref(1)) + enddo + if ( res == 0 ) res = 1 + Agrif_Mind(1) = 1. / res +! + res = 1. + do i = 1,coefrafmax-1 + res = res * FLOAT(Agrif_coeffref(2)) + enddo + if ( res == 0 ) res = 1 + Agrif_Mind(2) = 1. / res +! + res = 1. + do i = 1,coefrafmax-1 + res = res * FLOAT(Agrif_coeffref(3)) + enddo + if ( res == 0 ) res = 1 + Agrif_Mind(3) = 1. / res +! + endif +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Set_Rafmax +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Set_MaskMaxSearch +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Set_MaskMaxSearch ( mymaxsearch ) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: mymaxsearch +! + MaxSearch = mymaxsearch +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Set_MaskMaxSearch +!=================================================================================================== +! +!=================================================================================================== +! function Agrif_Level +!--------------------------------------------------------------------------------------------------- +function Agrif_Level ( ) +!--------------------------------------------------------------------------------------------------- + integer :: Agrif_Level ! Result +! + Agrif_Level = Agrif_Curgrid % level +!--------------------------------------------------------------------------------------------------- +end function Agrif_Level +!=================================================================================================== +! +!=================================================================================================== +! function Agrif_MaxLevel +!--------------------------------------------------------------------------------------------------- +function Agrif_MaxLevel ( ) +!--------------------------------------------------------------------------------------------------- + integer :: Agrif_MaxLevel ! Result +! + Agrif_MaxLevel = Agrif_MaxLevelLoc +!--------------------------------------------------------------------------------------------------- +end function Agrif_MaxLevel +!=================================================================================================== +! +!=================================================================================================== +! function Agrif_GridAllocation_is_done +!--------------------------------------------------------------------------------------------------- +function Agrif_GridAllocation_is_done ( ) result(isdone) +!--------------------------------------------------------------------------------------------------- + logical :: isdone +! + isdone = Agrif_Curgrid % allocation_is_done +!--------------------------------------------------------------------------------------------------- +end function Agrif_GridAllocation_is_done +!=================================================================================================== +! + +function Agrif_Parent_Real_4(real_variable) result(real_variable_parent) +real(KIND=4) :: real_variable +real(KIND=4) :: real_variable_parent + +integer :: i +logical :: i_found + +i_found = .FALSE. + +do i=1,Agrif_NbVariables(2) + if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%array0)) then + real_variable_parent = agrif_curgrid%tabvars_r(i)%parent_var%array0 + i_found = .TRUE. + EXIT + endif +enddo + +IF (.NOT.i_found) THEN +do i=1,Agrif_NbVariables(2) + if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%sarray0)) then + real_variable_parent = agrif_curgrid%tabvars_r(i)%parent_var%sarray0 + i_found = .TRUE. + EXIT + endif +enddo +ENDIF + +if (.NOT.i_found) STOP 'Agrif_Parent_Real_4 : Variable not found' + +end function Agrif_Parent_Real_4 + +function Agrif_Parent_Real_8(real_variable) result(real_variable_parent) +real(KIND=8) :: real_variable +real(KIND=8) :: real_variable_parent + +integer :: i +logical :: i_found + +i_found = .FALSE. + +do i=1,Agrif_NbVariables(2) + if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%array0)) then + real_variable_parent = agrif_curgrid%tabvars_r(i)%parent_var%array0 + i_found = .TRUE. + EXIT + endif +enddo + +IF (.NOT.i_found) THEN +do i=1,Agrif_NbVariables(2) + if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%darray0)) then + real_variable_parent = agrif_curgrid%tabvars_r(i)%parent_var%darray0 + i_found = .TRUE. + EXIT + endif +enddo +ENDIF + +if (.NOT.i_found) STOP 'Agrif_Parent_Real_8 : Variable not found' + +end function Agrif_Parent_Real_8 + +function Agrif_Parent_Array2_Real_8(real_variable,ji,jj) result(real_variable_parent) +real(KIND=8), DIMENSION(:,:) :: real_variable +real(KIND=8) :: real_variable_parent +integer :: ji,jj + +integer :: i +logical :: i_found + +i_found = .FALSE. + +do i=1,Agrif_NbVariables(0) + if (LOC(real_variable) == LOC(agrif_curgrid%tabvars(i)%array2)) then + real_variable_parent = agrif_curgrid%tabvars(i)%parent_var%array2(ji,jj) + i_found = .TRUE. + EXIT + endif +enddo + +if (.NOT.i_found) STOP 'Agrif_Parent_Array2_Real_8 : Variable not found' + +end function Agrif_Parent_Array2_Real_8 + + +function Agrif_Parent_Integer(integer_variable) result(integer_variable_parent) +integer :: integer_variable +integer :: integer_variable_parent + +integer :: i +logical :: i_found + +i_found = .FALSE. + +do i=1,Agrif_NbVariables(4) + if (LOC(integer_variable) == LOC(agrif_curgrid%tabvars_i(i)%iarray0)) then + integer_variable_parent = agrif_curgrid%tabvars_i(i)%parent_var%iarray0 + i_found = .TRUE. + EXIT + endif +enddo + +if (.NOT.i_found) STOP 'Agrif_Parent : Variable not found' + +end function Agrif_Parent_Integer + +function Agrif_Parent_Character(character_variable) result(character_variable_parent) +character(*) :: character_variable +character(len(character_variable)) :: character_variable_parent + +integer :: i +logical :: i_found + +i_found = .FALSE. + +do i=1,Agrif_NbVariables(1) + if (LOC(character_variable) == LOC(agrif_curgrid%tabvars_c(i)%carray0)) then + character_variable_parent = agrif_curgrid%tabvars_c(i)%parent_var%carray0 + i_found = .TRUE. + EXIT + endif +enddo + +if (.NOT.i_found) STOP 'Agrif_Parent : Variable not found' + +end function Agrif_Parent_Character + +function Agrif_Parent_Logical(logical_variable) result(logical_variable_parent) +logical :: logical_variable +logical :: logical_variable_parent + +integer :: i +logical :: i_found + +i_found = .FALSE. + +do i=1,Agrif_NbVariables(3) + if (LOC(logical_variable) == LOC(agrif_curgrid%tabvars_l(i)%larray0)) then + logical_variable_parent = agrif_curgrid%tabvars_l(i)%parent_var%larray0 + i_found = .TRUE. + EXIT + endif +enddo + +if (.NOT.i_found) STOP 'Agrif_Parent : Variable not found' + +end function Agrif_Parent_Logical + +function Agrif_Irhox() result(i_val) +integer :: i_val +i_val = agrif_curgrid%spaceref(1) +end function Agrif_Irhox + +function Agrif_Irhoy() result(i_val) +integer :: i_val +i_val = agrif_curgrid%spaceref(2) +end function Agrif_Irhoy + +function Agrif_Irhoz() result(i_val) +integer :: i_val +i_val = agrif_curgrid%spaceref(3) +end function Agrif_Irhoz + +function Agrif_NearCommonBorderX() result(l_val) +logical :: l_val +l_val = agrif_curgrid%nearRootBorder(1) +end function Agrif_NearCommonBorderX + +function Agrif_NearCommonBorderY() result(l_val) +logical :: l_val +l_val = agrif_curgrid%nearRootBorder(2) +end function Agrif_NearCommonBorderY + +function Agrif_NearCommonBorderZ() result(l_val) +logical :: l_val +l_val = agrif_curgrid%nearRootBorder(3) +end function Agrif_NearCommonBorderZ + +function Agrif_DistantCommonBorderX() result(l_val) +logical :: l_val +l_val = agrif_curgrid%DistantRootBorder(1) +end function Agrif_DistantCommonBorderX + +function Agrif_DistantCommonBorderY() result(l_val) +logical :: l_val +l_val = agrif_curgrid%DistantRootBorder(2) +end function Agrif_DistantCommonBorderY + +function Agrif_DistantCommonBorderZ() result(l_val) +logical :: l_val +l_val = agrif_curgrid%DistantRootBorder(3) +end function Agrif_DistantCommonBorderZ + +function Agrif_Ix() result(i_val) +integer :: i_val +i_val = agrif_curgrid%ix(1) +end function Agrif_Ix + +function Agrif_Iy() result(i_val) +integer :: i_val +i_val = agrif_curgrid%ix(2) +end function Agrif_Iy + +function Agrif_Iz() result(i_val) +integer :: i_val +i_val = agrif_curgrid%ix(3) +end function Agrif_Iz + +function Agrif_Get_grid_id() result(i_val) +integer :: i_val +i_val = agrif_curgrid % grid_id +end function Agrif_Get_grid_id + +function Agrif_Get_parent_id() result(i_val) +integer :: i_val +i_val = agrif_curgrid % parent % grid_id +end function Agrif_Get_parent_id + +function Agrif_rhox() result(r_val) +real :: r_val +r_val = real(agrif_curgrid%spaceref(1)) +end function Agrif_rhox + +function Agrif_rhoy() result(r_val) +real :: r_val +r_val = real(agrif_curgrid%spaceref(2)) +end function Agrif_rhoy + +function Agrif_rhoz() result(r_val) +real :: r_val +r_val = real(agrif_curgrid%spaceref(3)) +end function Agrif_rhoz + +function Agrif_Nb_Step() result(i_val) +integer :: i_val +i_val = agrif_curgrid%ngridstep +end function Agrif_Nb_Step + +function Agrif_Nb_Fine_Grids() result(i_val) +integer :: i_val +i_val = Agrif_nbfixedgrids +end function Agrif_Nb_Fine_Grids + +end module Agrif_CurgridFunctions diff --git a/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modgrids.F90 b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modgrids.F90 new file mode 100644 index 00000000..2dd4e3a4 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modgrids.F90 @@ -0,0 +1,478 @@ +module Agrif_Grids + + use Agrif_Types +! + implicit none +! +!=================================================================================================== +type Agrif_Grid_List +!--------------------------------------------------------------------------------------------------- +!< List of grids. +! + integer :: nitems = 0 !< Number of elements in the list + type(Agrif_PGrid), pointer :: first => NULL() !< Pointer to the first grid in the list + type(Agrif_PGrid), pointer :: last => NULL() !< Pointer to the last grid inserted in the list +!--------------------------------------------------------------------------------------------------- +end type Agrif_Grid_List +!=================================================================================================== +! +!=================================================================================================== +type Agrif_PGrid +!--------------------------------------------------------------------------------------------------- +!< Data type to go over the grid hierarchy (used for the creation of this grid hierarchy +!< and during the time integration). +! + type(Agrif_Grid) , pointer :: gr => NULL() !< Pointer to the actual grid data structure + type(Agrif_PGrid), pointer :: next => NULL() !< Next grid in the list +! +!--------------------------------------------------------------------------------------------------- +end type Agrif_PGrid +!=================================================================================================== +! +!=================================================================================================== +type Agrif_Grid +!--------------------------------------------------------------------------------------------------- +!< Data type to define a grid (position, space and time refinement factors). +! + type(Agrif_Grid) , pointer :: parent => NULL() !< pointer on the parent grid + type(Agrif_Grid) , pointer :: save_grid => NULL() !< pointer on the save grid + type(Agrif_Grid_List) :: child_list !< List of child grids + type(Agrif_Variable), dimension(:), allocatable :: tabvars !< List of grid variables + type(Agrif_Variable_c), dimension(:), allocatable :: tabvars_c !< List of character grid variables + type(Agrif_Variable_r), dimension(:), allocatable :: tabvars_r !< List of real grid variables + type(Agrif_Variable_l), dimension(:), allocatable :: tabvars_l !< List of logical grid variables + type(Agrif_Variable_i), dimension(:), allocatable :: tabvars_i !< List of integer grid variables +! + real , dimension(3) :: Agrif_x !< global x, y and z position + real , dimension(3) :: Agrif_dx !< global space step in the x, y and z direction + real , dimension(3) :: Agrif_dt !< global time step in the x, y and z direction + integer, dimension(3) :: nb !< number of cells in the x, y and z direction + integer, dimension(3) :: ix !< minimal position in the x, y and z direction + integer, dimension(3) :: spaceref !< space refinement factor in the x, y and z direction + integer, dimension(3) :: timeref !< Time refinement factor in the x, y and z direction + integer :: ngridstep !< number of time steps + integer :: rank + integer :: grid_id !< moving grid id + integer :: fixedrank !< number of the grid + logical :: fixed !< fixed or moving grid ? + logical :: oldgrid +!> \name Logicals indicating if the current grid has a common border with the root coarse grid +!> @{ + logical, dimension(3) :: NearRootBorder + logical, dimension(3) :: DistantRootBorder +!> @} +!> \name Arrays for adaptive grid refinement +!> @{ + integer, dimension(:) , allocatable :: tabpoint1D + integer, dimension(:,:) , allocatable :: tabpoint2D + integer, dimension(:,:,:), allocatable :: tabpoint3D +!> @} +!> \name Members for parallel integration +!> @{ + type(Agrif_Rectangle), pointer :: rect_in_parent => NULL() + type(Agrif_Grid_List) :: neigh_list !< List of neighboring grids (ie. connected through a common proc) + type(Agrif_Proc_List) :: proc_def_list !< List of procs that will integrate this grid + type(Agrif_Proc_List) :: proc_def_in_parent_list !< List of procs that will integrate this grid (defined as in the parent grid) + type(Agrif_Proc_List) :: required_proc_list !< List of procs that are required for this grid + type(Agrif_Sequence_List), pointer :: child_seq => NULL() !< Sequence for childs + integer :: seq_num = 0 + integer :: size = 0 + integer :: dsat = 0 +#if defined AGRIF_MPI + integer :: communicator = -1 +#endif +!> @} + type(Agrif_Variables_List), pointer :: variables => NULL() + integer :: NbVariables = 0 + integer :: level !< level of the grid in the hierarchy + logical :: allocation_is_done = .false. + logical :: grand_mother_grid = .false. +!--------------------------------------------------------------------------------------------------- +end type Agrif_Grid +!=================================================================================================== +! +!> this pointer always points on the root grid of the grid hierarchy +type(Agrif_Grid) , pointer :: Agrif_Mygrid => NULL() + +!> this pointer always points on the grand mother grid of the grid hierarchy (if any) +type(Agrif_Grid) , pointer :: Agrif_Coarsegrid => NULL() + +!> Grid list used in the \link Agrif_Util::Agrif_Regrid() Agrif_regrid \endlink subroutine. +!> It contains the safeguard of the grid hierarchy. +type(Agrif_Grid_List), pointer :: Agrif_oldmygrid => NULL() + +!> Pointer to the current grid (the link is done by using the Agrif_Instance procedure (\see module Agrif_Init)) +type(Agrif_Grid) , pointer :: Agrif_Curgrid => NULL() +! +!=================================================================================================== +type Agrif_Sequence +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid_List) :: gridlist + type(Agrif_Proc_List) :: proclist +!--------------------------------------------------------------------------------------------------- +end type Agrif_Sequence +!=================================================================================================== +! +!=================================================================================================== +type Agrif_Sequence_List +!--------------------------------------------------------------------------------------------------- + integer :: nb_seqs + type(Agrif_Sequence), dimension(:), allocatable :: sequences +!--------------------------------------------------------------------------------------------------- +end type Agrif_Sequence_List +!=================================================================================================== +! +interface + function compare_grids ( grid1, grid2 ) result( res ) + import Agrif_Grid + type(Agrif_Grid), intent(in) :: grid1 + type(Agrif_Grid), intent(in) :: grid2 + integer :: res !< Result of the comparison : + !! - res < 0 if grid1 < grid2 + !! - res == 0 if grid1 == grid2 + !! - res > 0 if grid1 > grid2 + end function compare_grids +end interface +! +contains +! +!=================================================================================================== +subroutine Agrif_gl_print ( gridlist ) +! +!< DEBUG : a virer à terme. +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid_List), intent(in) :: gridlist +! + type(Agrif_PGrid), pointer :: gridp + type(Agrif_Grid), pointer :: grid +! + gridp => gridlist % first + do while ( associated(gridp) ) + grid => gridp % gr + write(*,'("G",i0,", ")', advance='no') grid % fixedrank + gridp => gridp % next + enddo + write(*,*) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_gl_print +!=================================================================================================== +! +!=================================================================================================== +subroutine Agrif_gl_print_debug ( gridlist ) +! +!< DEBUG : a virer à terme. +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid_List), intent(in) :: gridlist +! + type(Agrif_PGrid), pointer :: gridp + type(Agrif_Grid), pointer :: grid +! + write(*,'(" (nitems=",i2,"), (id,neighs,color,dsat,size) = ")', advance='no') gridlist % nitems + gridp => gridlist % first + do while ( associated(gridp) ) + grid => gridp % gr + write(*,'("(G",i0,4(",",i0),"), ")', advance='no') grid % fixedrank, & + grid % neigh_list % nitems, grid % seq_num, grid % dsat, grid % size + gridp => gridp % next + enddo + write(*,*) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_gl_print_debug +!=================================================================================================== +! +!=================================================================================================== +subroutine Agrif_gl_append ( gridlist, grid ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid_List), intent(inout) :: gridlist + type(Agrif_Grid), pointer, intent(in) :: grid +! + type(Agrif_PGrid), pointer :: new_gp +! + allocate( new_gp ) +! + new_gp % gr => grid + new_gp % next => NULL() +! + if ( associated(gridlist % last) ) then + ! the list is not empty, append the new pointer at the end + gridlist % last % next => new_gp + else + ! the list is empty, the new pointer is the first one + gridlist % first => new_gp + endif + ! anyway, for next time 'grid' will be the last one. + gridlist % last => new_gp + gridlist % nitems = gridlist % nitems + 1 +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_gl_append +!=================================================================================================== +! +!=================================================================================================== +function Agrif_gl_popfirst ( gridlist ) result ( grid ) +! +!< Removes the first item of the list and returns it. +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid_List), intent(inout) :: gridlist +! + type(Agrif_PGrid), pointer :: grid_p + type(Agrif_Grid), pointer :: grid +! + grid_p => gridlist % first +! + if ( .not. associated( grid_p ) ) then + grid => NULL() + return + endif +! + grid => grid_p % gr + gridlist % first => grid_p % next + gridlist % nitems = gridlist % nitems - 1 + if ( .not. associated(gridlist % first) ) then + nullify(gridlist % last) + endif + deallocate(grid_p) +!--------------------------------------------------------------------------------------------------- +end function Agrif_gl_popfirst +!=================================================================================================== +! +!=================================================================================================== +subroutine Agrif_gl_copy ( new_gl, model ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid_List), intent(out) :: new_gl + type(Agrif_Grid_List), intent(in) :: model +! + type(Agrif_PGrid), pointer :: gp +! + call Agrif_gl_clear(new_gl) + gp => model % first +! + do while( associated(gp) ) + call Agrif_gl_append( new_gl, gp % gr ) + gp => gp % next + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_gl_copy +!=================================================================================================== +! +!=================================================================================================== +function Agrif_gl_build_from_gp ( gridp ) result ( gridlist ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_PGrid), pointer, intent(in) :: gridp +! + type(Agrif_Grid_List), pointer :: gridlist + type(Agrif_PGrid), pointer :: gp +! + allocate(gridlist) +! + gp => gridp +! + do while ( associated( gp ) ) + call Agrif_gl_append( gridlist, gp % gr ) + gp => gp % next + enddo +!--------------------------------------------------------------------------------------------------- +end function Agrif_gl_build_from_gp +!=================================================================================================== +! +!=================================================================================================== +subroutine Agrif_gp_delete ( gridp ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_PGrid), pointer, intent(inout) :: gridp +! + type(Agrif_PGrid), pointer :: gp, gpd +! + if ( .not. associated( gridp ) ) return +! + gp => gridp +! + do while( associated(gp) ) + gpd => gp + gp => gp % next + deallocate(gpd) + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_gp_delete +!=================================================================================================== +! +!=================================================================================================== +subroutine Agrif_gl_clear ( gridlist ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid_List), intent(inout) :: gridlist +! + call Agrif_gp_delete(gridlist % first) + gridlist % first => NULL() + gridlist % last => NULL() + gridlist % nitems = 0 +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_gl_clear +!=================================================================================================== +! +!=================================================================================================== +subroutine Agrif_gl_delete ( gridlist ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid_List), pointer, intent(inout) :: gridlist +! + if ( .not. associated( gridlist ) ) return +! + call Agrif_gp_delete(gridlist % first) + deallocate( gridlist ) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_gl_delete +!=================================================================================================== +! +!=================================================================================================== +recursive function Agrif_gl_merge_sort ( gridlist, compare_func, compare_func_opt ) result( gl_sorted ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid_List), intent(in) :: gridlist + procedure(compare_grids) :: compare_func + procedure(compare_grids), optional :: compare_func_opt +! + type(Agrif_Grid_List), pointer :: gl_sorted + type(Agrif_Grid_List), pointer :: gl_left, gl_sorted_left + type(Agrif_Grid_List), pointer :: gl_right, gl_sorted_right + type(Agrif_PGrid), pointer :: grid_p + integer :: n, middle +! +! if list size is 1, consider it sorted and return it + if ( (gridlist % nitems <= 1) ) then + gl_sorted => Agrif_gl_build_from_gp(gridlist % first) + return + endif +! +! else split the list into two sublists + n = 1 + middle = gridlist % nitems / 2 + grid_p => gridlist % first +! + allocate( gl_left, gl_right ) +! + do while ( associated(grid_p) ) + if ( n <= middle ) then + call Agrif_gl_append(gl_left, grid_p % gr) + else + call Agrif_gl_append(gl_right, grid_p % gr) + endif + grid_p => grid_p % next + n = n+1 + enddo +! +! recursively call Agrif_gl_merge_sort() to further split each sublist until sublist size is 1 + gl_sorted_left => Agrif_gl_merge_sort(gl_left, compare_func, compare_func_opt) + gl_sorted_right => Agrif_gl_merge_sort(gl_right, compare_func, compare_func_opt) +! +! merge the sublists returned from prior calls to gl_merge_sort() and return the resulting merged sublist + gl_sorted => Agrif_gl_merge(gl_sorted_left, gl_sorted_right, compare_func, compare_func_opt) +! + call Agrif_gl_delete( gl_left ) + call Agrif_gl_delete( gl_right ) + call Agrif_gl_delete( gl_sorted_left ) + call Agrif_gl_delete( gl_sorted_right ) +!--------------------------------------------------------------------------------------------------- +end function Agrif_gl_merge_sort +!=================================================================================================== +! +!=================================================================================================== +function Agrif_gl_merge ( gl_left, gl_right, compare_func, compare_func_opt ) result( gl_merged ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid_List), intent(inout) :: gl_left + type(Agrif_Grid_List), intent(inout) :: gl_right + procedure(compare_grids) :: compare_func + procedure(compare_grids), optional :: compare_func_opt +! + type(Agrif_Grid_List), pointer :: gl_merged + type(Agrif_Grid), pointer :: poped_grid + integer :: comp_value +! + allocate( gl_merged ) +! + do while ( gl_left % nitems > 0 .or. gl_right % nitems > 0 ) +! + if ( gl_left % nitems > 0 .and. gl_right % nitems > 0 ) then +! +! Let.s compare both items with the first compare function + comp_value = compare_func( gl_left % first % gr, gl_right % first % gr ) +! + if ( comp_value < 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_left) + elseif ( comp_value > 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_right) + else ! ( comp_value == 0 ) +! +! Both items are equal, let.s use the second criterion if the optional +! compare function is present. + if ( present(compare_func_opt) ) then +! + comp_value = compare_func_opt( gl_left % first % gr, gl_right % first % gr ) +! + if ( comp_value <= 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_left) + else ; poped_grid => Agrif_gl_popfirst(gl_right) + endif + else +! If the second criterion is not present, let.s just pick the left item + poped_grid => Agrif_gl_popfirst(gl_left) + endif + endif +! +! If one of the lists is empty, we just have to pick in the other one. + elseif ( gl_left % nitems > 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_left) + elseif ( gl_right % nitems > 0 ) then ; poped_grid => Agrif_gl_popfirst(gl_right) + endif +! + call Agrif_gl_append( gl_merged, poped_grid ) +! + enddo +!--------------------------------------------------------------------------------------------------- +end function Agrif_gl_merge +!=================================================================================================== +! +!=================================================================================================== +function compare_grid_degrees ( grid1, grid2 ) result( res ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid), intent(in) :: grid1 + type(Agrif_Grid), intent(in) :: grid2 +! + integer :: res +! + res = grid2 % neigh_list % nitems - grid1 % neigh_list % nitems +!--------------------------------------------------------------------------------------------------- +end function compare_grid_degrees +!=================================================================================================== +! +!=================================================================================================== +function compare_colors ( grid1, grid2 ) result( res ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid), intent(in) :: grid1 + type(Agrif_Grid), intent(in) :: grid2 +! + integer :: res +! + res = grid1 % seq_num - grid2 % seq_num +!--------------------------------------------------------------------------------------------------- +end function compare_colors +!=================================================================================================== +! +!=================================================================================================== +function compare_dsat_values ( grid1, grid2 ) result( res ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid), intent(in) :: grid1 + type(Agrif_Grid), intent(in) :: grid2 +! + integer :: res +! + res = grid2 % dsat - grid1 % dsat +!--------------------------------------------------------------------------------------------------- +end function compare_dsat_values +!=================================================================================================== +! +!=================================================================================================== +function compare_size_values ( grid1, grid2 ) result( res ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid), intent(in) :: grid1 + type(Agrif_Grid), intent(in) :: grid2 +! + integer :: res +! + res = grid2 % size - grid1 % size +!--------------------------------------------------------------------------------------------------- +end function compare_size_values +!=================================================================================================== +! +end module Agrif_Grids diff --git a/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modinit.F90 b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modinit.F90 new file mode 100644 index 00000000..9e1c61a6 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modinit.F90 @@ -0,0 +1,209 @@ +! AGRIF (Adaptive Grid Refinement In Fortran) +! +! Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr) +! Christophe Vouland (Christophe.Vouland@imag.fr) +! +! This program is free software; you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation; either version 2 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program; if not, write to the Free Software +! Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA. +! +! +!> Module Agrif_Init. +!> +!> Several operations on the variables of the current grid (creation, instanciation, ...) +!! used during the creation of the grid hierarchy and during the time integration. +! +module Agrif_Init +! + use Agrif_Grids + use Agrif_Link + use Agrif_Mpp +! + implicit none +! +contains +! +!=================================================================================================== +! subroutine Agrif_Allocation +! +!> Allocates the arrays containing the values of the variables of the current grd. +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Allocation ( Agrif_Gr, procname ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid), pointer :: Agrif_Gr !< Pointer on the current grid + procedure(alloc_proc), optional :: procname !< Allocation procedure (Default: Agrif_Allocationcalls) +! + if ( present(procname) ) then + call procname(Agrif_Gr) + else + call Agrif_Allocationcalls(Agrif_Gr) + endif + Agrif_Gr % allocation_is_done = .true. +! + if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) then +! + if ( Agrif_Probdim == 1 ) allocate( Agrif_Gr%tabpoint1D(Agrif_Gr%nb(1)+1) ) + if ( Agrif_Probdim == 2 ) allocate( Agrif_Gr%tabpoint2D(Agrif_Gr%nb(1)+1, & + Agrif_Gr%nb(2)+1) ) + if ( Agrif_Probdim == 3 ) allocate( Agrif_Gr%tabpoint3D(Agrif_Gr%nb(1)+1, & + Agrif_Gr%nb(2)+1, & + Agrif_Gr%nb(3)+1) ) + endif +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Allocation +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Instance +! +!> Make the pointer Agrif_Types::Agrif_Curgrid point to Agrif_Gr +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Instance ( Agrif_Gr ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid), pointer :: Agrif_Gr !< Pointer on the current grid +! + Agrif_Curgrid => Agrif_Gr + Agrif_tabvars => Agrif_Curgrid % tabvars + Agrif_tabvars_c => Agrif_Curgrid % tabvars_c + Agrif_tabvars_r => Agrif_Curgrid % tabvars_r + Agrif_tabvars_l => Agrif_Curgrid % tabvars_l + Agrif_tabvars_i => Agrif_Curgrid % tabvars_i +! +#if defined AGRIF_MPI + if ( Agrif_Gr % communicator /= -1 ) then + call Agrif_MPI_switch_comm( Agrif_Gr % communicator ) + endif +#endif +! + call Agrif_Get_numberofcells(Agrif_Gr) + call Agrif_InitWorkSpace() +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Instance +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_initialisations +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_initialisations ( Agrif_Gr ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid), pointer :: Agrif_Gr !< Pointer on the current grid +! + integer :: i + type(Agrif_Variable), pointer :: var => NULL() + type(Agrif_Variable_c), pointer :: var_c => NULL() + type(Agrif_Variable_r), pointer :: var_r => NULL() + type(Agrif_Variable_l), pointer :: var_l => NULL() + type(Agrif_Variable_i), pointer :: var_i => NULL() +! + do i = 1,Agrif_NbVariables(0) +! + var => Agrif_Gr % tabvars(i) + var % nbdim = 0 +! + if (allocated(var%array1)) then + var % nbdim = 1 + var % lb(1:1) = lbound(var%array1) + var % ub(1:1) = ubound(var%array1) + endif + if (allocated(var%array2)) then + var % nbdim = 2 + var % lb(1:2) = lbound(var%array2) + var % ub(1:2) = ubound(var%array2) + endif + if (allocated(var%array3)) then + var % nbdim = 3 + var % lb(1:3) = lbound(var%array3) + var % ub(1:3) = ubound(var%array3) + endif + if (allocated(var%array4)) then + var % nbdim = 4 + var % lb(1:4) = lbound(var%array4) + var % ub(1:4) = ubound(var%array4) + endif + if (allocated(var%array5)) then + var % nbdim = 5 + var % lb(1:5) = lbound(var%array5) + var % ub(1:5) = ubound(var%array5) + endif + if (allocated(var%array6)) then + var % nbdim = 6 + var % lb(1:6) = lbound(var%array6) + var % ub(1:6) = ubound(var%array6) + endif +! + if (allocated(var%darray1)) var % nbdim = 1 + if (allocated(var%darray2)) var % nbdim = 2 + if (allocated(var%darray3)) var % nbdim = 3 + if (allocated(var%darray4)) var % nbdim = 4 + if (allocated(var%darray5)) var % nbdim = 5 + if (allocated(var%darray6)) var % nbdim = 6 +! + if (allocated(var%sarray1)) var % nbdim = 1 + if (allocated(var%sarray2)) var % nbdim = 2 + if (allocated(var%sarray3)) var % nbdim = 3 + if (allocated(var%sarray4)) var % nbdim = 4 + if (allocated(var%sarray5)) var % nbdim = 5 + if (allocated(var%sarray6)) var % nbdim = 6 +! + enddo + + do i = 1,Agrif_NbVariables(1) +! + var_c => Agrif_Gr % tabvars_c(i) + var_c % nbdim = 0 +! + if (allocated(var_c%carray1)) var_c % nbdim = 1 + if (allocated(var_c%carray2)) var_c % nbdim = 2 +! + enddo + + do i = 1,Agrif_NbVariables(2) +! + var_r => Agrif_Gr % tabvars_r(i) + var_r % nbdim = 0 +! + enddo + + do i = 1,Agrif_NbVariables(3) +! + var_l => Agrif_Gr % tabvars_l(i) + var_l % nbdim = 0 +! + if (allocated(var_l%larray1)) var_l % nbdim = 1 + if (allocated(var_l%larray2)) var_l % nbdim = 2 + if (allocated(var_l%larray3)) var_l % nbdim = 3 + if (allocated(var_l%larray4)) var_l % nbdim = 4 + if (allocated(var_l%larray5)) var_l % nbdim = 5 + if (allocated(var_l%larray6)) var_l % nbdim = 6 +! + enddo + + do i = 1,Agrif_NbVariables(4) +! + var_i => Agrif_Gr % tabvars_i(i) + var_i % nbdim = 0 +! + if (allocated(var_i%iarray1)) var_i % nbdim = 1 + if (allocated(var_i%iarray2)) var_i % nbdim = 2 + if (allocated(var_i%iarray3)) var_i % nbdim = 3 + if (allocated(var_i%iarray4)) var_i % nbdim = 4 + if (allocated(var_i%iarray5)) var_i % nbdim = 5 + if (allocated(var_i%iarray6)) var_i % nbdim = 6 +! + enddo + +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_initialisations +!=================================================================================================== +! +end module Agrif_Init diff --git a/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modinitvars.F90 b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modinitvars.F90 new file mode 100644 index 00000000..a805c2d7 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modinitvars.F90 @@ -0,0 +1,86 @@ +! +! $Id: modinitvars.F 662 2007-05-25 15:58:52Z opalod $ +! +! Agrif (Adaptive Grid Refinement In Fortran) +! +! Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr) +! Christophe Vouland (Christophe.Vouland@imag.fr) +! +! This program is free software; you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation; either version 2 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program; if not, write to the Free Software +! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +! +! +!> Module Agrif_Init_Vars +!> +!> Initialization of the variables of the current grid. +! +module Agrif_Init_Vars +! + use Agrif_Types + use Agrif_Grids + use Agrif_Link +! + implicit none +! +contains +! +!=================================================================================================== +! subroutine Agrif_Create_Var +! +!> Allocation of the list of grid variables for grid Agrif_Gr. +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Create_Var ( Agrif_Gr ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid), pointer :: Agrif_Gr !< Pointer on the current grid +! + integer :: nb +! + if (Agrif_NbVariables(0) > 0) allocate(Agrif_Gr % tabvars (Agrif_NbVariables(0))) + if (Agrif_NbVariables(1) > 0) allocate(Agrif_Gr % tabvars_c(Agrif_NbVariables(1))) + if (Agrif_NbVariables(2) > 0) allocate(Agrif_Gr % tabvars_r(Agrif_NbVariables(2))) + if (Agrif_NbVariables(3) > 0) allocate(Agrif_Gr % tabvars_l(Agrif_NbVariables(3))) + if (Agrif_NbVariables(4) > 0) allocate(Agrif_Gr % tabvars_i(Agrif_NbVariables(4))) +! + if ( Agrif_Gr % fixedrank /= 0 ) then + do nb = 1, Agrif_NbVariables(0) + Agrif_Gr % tabvars(nb) % parent_var => Agrif_Gr % parent % tabvars(nb) + Agrif_Gr % tabvars(nb) % nbdim = Agrif_Mygrid % tabvars(nb) % nbdim + Agrif_Gr % tabvars(nb) % root_var => Agrif_Mygrid % tabvars(nb) + enddo + do nb = 1, Agrif_NbVariables(1) + Agrif_Gr % tabvars_c(nb) % parent_var => Agrif_Gr % parent % tabvars_c(nb) + Agrif_Gr % tabvars_c(nb) % nbdim = Agrif_Mygrid % tabvars_c(nb) % nbdim + Agrif_Gr % tabvars_c(nb) % root_var => Agrif_Mygrid % tabvars_c(nb) + enddo + do nb = 1, Agrif_NbVariables(2) + Agrif_Gr % tabvars_r(nb) % parent_var => Agrif_Gr % parent % tabvars_r(nb) + Agrif_Gr % tabvars_r(nb) % nbdim = Agrif_Mygrid % tabvars_r(nb) % nbdim + Agrif_Gr % tabvars_r(nb) % root_var => Agrif_Mygrid % tabvars_r(nb) + enddo + do nb = 1, Agrif_NbVariables(3) + Agrif_Gr % tabvars_l(nb) % parent_var => Agrif_Gr % parent % tabvars_l(nb) + Agrif_Gr % tabvars_l(nb) % nbdim = Agrif_Mygrid % tabvars_l(nb) % nbdim + Agrif_Gr % tabvars_l(nb) % root_var => Agrif_Mygrid % tabvars_l(nb) + enddo + do nb = 1, Agrif_NbVariables(4) + Agrif_Gr % tabvars_i(nb) % parent_var => Agrif_Gr % parent % tabvars_i(nb) + Agrif_Gr % tabvars_i(nb) % nbdim = Agrif_Mygrid % tabvars_i(nb) % nbdim + Agrif_Gr % tabvars_i(nb) % root_var => Agrif_Mygrid % tabvars_i(nb) + enddo + endif +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Create_Var +!=================================================================================================== +! +end module Agrif_Init_Vars diff --git a/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modinterp.F90 b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modinterp.F90 new file mode 100644 index 00000000..bd509af0 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modinterp.F90 @@ -0,0 +1,1534 @@ +! +! $Id: modinterp.F 779 2007-12-22 17:04:17Z rblod $ +! +! AGRIF (Adaptive Grid Refinement In Fortran) +! +! Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr) +! Christophe Vouland (Christophe.Vouland@imag.fr) +! +! This program is free software; you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation; either version 2 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program; if not, write to the Free Software +! Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA. +! +! +!> Module to initialize a fine grid from its parent grid, by using a space interpolation +! +module Agrif_Interpolation +! + use Agrif_InterpBasic + use Agrif_Arrays + use Agrif_Mask + use Agrif_CurgridFunctions +#if defined AGRIF_MPI + use Agrif_Mpp +#endif +! + implicit none +! + logical, private:: precomputedone(7) = .FALSE. +! + private :: Agrif_Parentbounds + private :: Agrif_Interp_1D_recursive, Agrif_Interp_2D_recursive, Agrif_Interp_3D_recursive + private :: Agrif_Interp_4D_recursive, Agrif_Interp_5D_recursive, Agrif_Interp_6D_recursive + private :: Agrif_InterpBase + private :: Agrif_Find_list_interp, Agrif_AddTo_list_interp +! +contains +! +!=================================================================================================== +! subroutine Agrif_InterpVariable +! +!> Sets some arguments of subroutine Agrif_InterpnD, n being the dimension of the grid variable +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_InterpVariable ( parent, child, torestore, procname ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Variable), pointer :: parent !< Variable on the parent grid + type(Agrif_Variable), pointer :: child !< Variable on the child grid + logical, intent(in) :: torestore !< .false. indicates that the results of the + !! interpolation are applied on the whole current grid + procedure() :: procname !< Data recovery procedure +!--------------------------------------------------------------------------------------------------- + logical :: memberin + integer :: nbdim ! Number of dimensions of the current grid + integer, dimension(6) :: type_interp ! Type of interpolation (linear,spline,...) + integer, dimension(6) :: nb_child + integer, dimension(6) :: lb_child + integer, dimension(6) :: ub_child + integer, dimension(6) :: lb_parent + real , dimension(6) :: s_child, s_parent + real , dimension(6) :: ds_child, ds_parent + integer, dimension(child % root_var % nbdim,2,2) :: childarray +! + nbdim = child % root_var % nbdim + type_interp = child % root_var % type_interp +! + call PreProcessToInterpOrUpdate( parent, child, & + nb_child, ub_child, & + lb_child, lb_parent, & + s_child, s_parent, & + ds_child, ds_parent, nbdim, interp=.true.) +! +! Call to a procedure of interpolation against the number of dimensions of the grid variable +! + call Agrif_InterpnD(type_interp, parent, child, & + lb_child, ub_child, & + lb_child, lb_parent, & + s_child, s_parent, & + ds_child, ds_parent, & + child, torestore, nbdim, & + childarray, memberin, & + .false., procname, 0, 0) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_InterpVariable +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_InterpnD +! +!> Interpolates a nD grid variable from its parent grid, by using a space interpolation +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_InterpnD ( type_interp, parent, child, pttab, petab, pttab_Child, pttab_Parent, & + s_Child, s_Parent, ds_Child, ds_Parent, restore, torestore, & + nbdim, childarray, memberin, in_bc, procname, nb, ndir ) +!--------------------------------------------------------------------------------------------------- +#if defined AGRIF_MPI + include 'mpif.h' +#endif +! + INTEGER, DIMENSION(6), INTENT(in) :: type_interp !< Type of interpolation ! (linear,...) + TYPE(Agrif_Variable), pointer :: parent !< Variable of the parent grid + TYPE(Agrif_Variable), pointer :: child !< Variable of the child grid + INTEGER, DIMENSION(nbdim), INTENT(in) :: pttab !< Index of the first point inside the domain + INTEGER, DIMENSION(nbdim), INTENT(in) :: petab !< Index of the first point inside the domain + INTEGER, DIMENSION(nbdim), INTENT(in) :: pttab_Child !< Index of the first point inside the domain + !< for the child grid variable + INTEGER, DIMENSION(nbdim), INTENT(in) :: pttab_Parent !< Index of the first point inside the domain + !< for the parent grid variable + REAL, DIMENSION(nbdim), INTENT(in) :: s_Child,s_Parent !< Positions of the parent and child grids + REAL, DIMENSION(nbdim), INTENT(in) :: ds_Child,ds_Parent !< Space steps of the parent and child grids + TYPE(Agrif_Variable), pointer :: restore !< Indicates points where interpolation + LOGICAL, INTENT(in) :: torestore !< Indicates if the array restore is used + INTEGER, INTENT(in) :: nbdim + LOGICAL, INTENT(out) :: memberin + LOGICAL, INTENT(in) :: in_bc !< .true. if called from Agrif_CorrectVariable \n + !! .false. if called from Agrif_InterpVariable + procedure() :: procname !< Data recovery procedure + INTEGER, INTENT(in) :: nb, ndir +! + INTEGER :: i,j,k,l,m,n + INTEGER, DIMENSION(nbdim) :: pttruetab,cetruetab + INTEGER, DIMENSION(nbdim) :: indmin, indmax + INTEGER, DIMENSION(nbdim) :: indminglob, indmaxglob +#if defined AGRIF_MPI + INTEGER, DIMENSION(nbdim) :: indminglob2,indmaxglob2 + INTEGER, DIMENSION(nbdim) :: indminglob3,indmaxglob3 +#endif + LOGICAL, DIMENSION(nbdim) :: noraftab + REAL , DIMENSION(nbdim) :: s_Child_temp,s_Parent_temp + INTEGER, DIMENSION(nbdim) :: lowerbound, upperbound, coords + INTEGER, DIMENSION(nbdim,2,2), INTENT(OUT) :: childarray + INTEGER, DIMENSION(nbdim,2,2) :: parentarray + LOGICAL :: member + LOGICAL :: find_list_interp +! +#if defined AGRIF_MPI +! + INTEGER, PARAMETER :: etiquette = 100 + INTEGER :: code, local_proc + INTEGER, DIMENSION(nbdim,4) :: tab3 + INTEGER, DIMENSION(nbdim,4,0:Agrif_Nbprocs-1) :: tab4 + INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t + INTEGER,DIMENSION(nbdim,2) :: tab5 + INTEGER,DIMENSION(nbdim,2,0:Agrif_Nbprocs-1) :: tab6 + INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,2) :: tab5t + LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall + LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1, recvfromproc1 + LOGICAL, DIMENSION(1) :: memberin1 + LOGICAL :: memberout +! +#endif +! + type(Agrif_Variable), pointer, save :: tempC => NULL() ! Temporary child grid variable + type(Agrif_Variable), pointer, save :: tempP => NULL() ! Temporary parent grid variable + type(Agrif_Variable), pointer, save :: tempPextend => NULL() ! Temporary parent grid variable + type(Agrif_Variable), pointer, save :: parentvalues => NULL() +! + coords = child % root_var % coords +! +! Boundaries of the current grid where interpolation is done + find_list_interp = & + Agrif_Find_list_interp( & + child % list_interp, & + pttab, petab, pttab_Child, pttab_Parent, nbdim, & + indmin, indmax, indminglob, indmaxglob, & + pttruetab, cetruetab, memberin & +#if defined AGRIF_MPI + ,indminglob2, indmaxglob2, parentarray, & + member, tab4t,memberinall, sendtoproc1, recvfromproc1 & +#endif + ) +! + if (.not.find_list_interp) then +! + call Agrif_get_var_bounds_array(child, lowerbound, upperbound, nbdim) + call Agrif_Childbounds(nbdim, lowerbound, upperbound, & + pttab, petab, Agrif_Procrank, coords, & + pttruetab, cetruetab, memberin) + call Agrif_Parentbounds(type_interp,nbdim,indminglob,indmaxglob, & + s_Parent_temp,s_Child_temp, & + s_Child,ds_Child, & + s_Parent,ds_Parent, & + pttab,petab, & + pttab_Child,pttab_Parent, & + child%root_var % posvar, coords) +#if defined AGRIF_MPI + if (memberin) then + call Agrif_Parentbounds(type_interp,nbdim,indmin,indmax, & + s_Parent_temp,s_Child_temp, & + s_Child,ds_Child, & + s_Parent,ds_Parent, & + pttruetab,cetruetab, & + pttab_Child,pttab_Parent, & + child%root_var % posvar, coords) + endif + + local_proc = Agrif_Procrank + call Agrif_get_var_bounds_array(parent,lowerbound,upperbound,nbdim) + call Agrif_ChildGrid_to_ParentGrid() +! + call Agrif_Childbounds(nbdim,lowerbound,upperbound, & + indminglob,indmaxglob, local_proc, coords, & + indminglob2,indmaxglob2,member, & + indminglob3,indmaxglob3) +! + if (member) then + call Agrif_GlobalToLocalBounds(parentarray, & + lowerbound, upperbound, & + indminglob2, indmaxglob2, coords,& + nbdim, local_proc, member) + endif + + call Agrif_ParentGrid_to_ChildGrid() +#else + parentarray(:,1,1) = indminglob + parentarray(:,2,1) = indmaxglob + parentarray(:,1,2) = indminglob + parentarray(:,2,2) = indmaxglob + indmin = indminglob + indmax = indmaxglob + member = .TRUE. +#endif +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Correct for non refined directions +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + do i=1,nbdim + if (coords(i) == 0) then + indmin(i) = indminglob(i) + indmax(i) = indmaxglob(i) + pttruetab(i) = indminglob(i) + cetruetab(i) = indmaxglob(i) + endif + enddo + + else + +#if defined AGRIF_MPI + s_Parent_temp = s_Parent + (indmin - pttab_Parent) * ds_Parent + s_Child_temp = s_Child + (pttruetab - pttab_Child) * ds_Child +#else + parentarray(:,1,1) = indminglob + parentarray(:,2,1) = indmaxglob + parentarray(:,1,2) = indminglob + parentarray(:,2,2) = indmaxglob + indmin = indminglob + indmax = indmaxglob + member = .TRUE. + s_Parent_temp = s_Parent + (indminglob - pttab_Parent) * ds_Parent + s_Child_temp = s_Child + (pttab - pttab_Child) * ds_Child +#endif + endif +! + if (member) then + if (.not.associated(tempP)) allocate(tempP) +! + call Agrif_array_allocate(tempP,parentarray(:,1,1),parentarray(:,2,1),nbdim) + call Agrif_var_set_array_tozero(tempP,nbdim) + + call Agrif_ChildGrid_to_ParentGrid() +! + select case (nbdim) + case(1) + call procname(tempP%array1, & + parentarray(1,1,2),parentarray(1,2,2),.TRUE.,nb,ndir) + case(2) + call procname(tempP%array2, & + parentarray(1,1,2),parentarray(1,2,2), & + parentarray(2,1,2),parentarray(2,2,2),.TRUE.,nb,ndir) + case(3) + call procname(tempP%array3, & + parentarray(1,1,2),parentarray(1,2,2), & + parentarray(2,1,2),parentarray(2,2,2), & + parentarray(3,1,2),parentarray(3,2,2),.TRUE.,nb,ndir) + case(4) + call procname(tempP%array4, & + parentarray(1,1,2),parentarray(1,2,2), & + parentarray(2,1,2),parentarray(2,2,2), & + parentarray(3,1,2),parentarray(3,2,2), & + parentarray(4,1,2),parentarray(4,2,2),.TRUE.,nb,ndir) + case(5) + call procname(tempP%array5, & + parentarray(1,1,2),parentarray(1,2,2), & + parentarray(2,1,2),parentarray(2,2,2), & + parentarray(3,1,2),parentarray(3,2,2), & + parentarray(4,1,2),parentarray(4,2,2), & + parentarray(5,1,2),parentarray(5,2,2),.TRUE.,nb,ndir) + case(6) + call procname(tempP%array6, & + parentarray(1,1,2),parentarray(1,2,2), & + parentarray(2,1,2),parentarray(2,2,2), & + parentarray(3,1,2),parentarray(3,2,2), & + parentarray(4,1,2),parentarray(4,2,2), & + parentarray(5,1,2),parentarray(5,2,2), & + parentarray(6,1,2),parentarray(6,2,2),.TRUE.,nb,ndir) + end select +! + call Agrif_ParentGrid_to_ChildGrid() +! + endif + +#if defined AGRIF_MPI + if (.not.find_list_interp) then +! + tab3(:,1) = indminglob2(:) + tab3(:,2) = indmaxglob2(:) + tab3(:,3) = indmin(:) + tab3(:,4) = indmax(:) + tab5(:,1) = indminglob3(:) + tab5(:,2) = indmaxglob3(:) +! + call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim,MPI_INTEGER,Agrif_mpi_comm,code) + call MPI_ALLGATHER(tab5,2*nbdim,MPI_INTEGER,tab6,2*nbdim,MPI_INTEGER,Agrif_mpi_comm,code) + if (.not.associated(tempPextend)) allocate(tempPextend) + + do k=0,Agrif_Nbprocs-1 + do j=1,4 + do i=1,nbdim + tab4t(i,k,j) = tab4(i,j,k) + enddo + enddo + enddo + + do k=0,Agrif_Nbprocs-1 + do j=1,2 + do i=1,nbdim + tab5t(i,k,j) = tab6(i,j,k) + enddo + enddo + enddo + + memberin1(1) = memberin + call MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall,1,MPI_LOGICAL,Agrif_mpi_comm,code) + + call Get_External_Data_first(tab4t(:,:,1),tab4t(:,:,2), & + tab4t(:,:,3),tab4t(:,:,4), & + nbdim,memberinall, coords, & + sendtoproc1,recvfromproc1, & + tab4t(:,:,5),tab4t(:,:,6), & + tab4t(:,:,7),tab4t(:,:,8), & + tab5t(:,:,1),tab5t(:,:,2)) + endif + + call ExchangeSameLevel(sendtoproc1,recvfromproc1,nbdim, & + tab4t(:,:,3),tab4t(:,:,4),tab4t(:,:,5),tab4t(:,:,6), & + tab4t(:,:,7),tab4t(:,:,8),memberin,tempP,tempPextend) +#else + tempPextend => tempP +#endif + + if (.not.find_list_interp) then + call Agrif_Addto_list_interp( & + child%list_interp,pttab,petab, & + pttab_Child,pttab_Parent,indmin,indmax, & + indminglob,indmaxglob, & + pttruetab,cetruetab, & + memberin,nbdim & +#if defined AGRIF_MPI + ,indminglob2,indmaxglob2, & + parentarray, & + member, & + tab4t,memberinall,sendtoproc1,recvfromproc1 & +#endif + ) + endif +! + if (memberin) then +! + if (.not.associated(tempC)) allocate(tempC) +! + call Agrif_array_allocate(tempC,pttruetab,cetruetab,nbdim) +! +! Special values on the parent grid + if (Agrif_UseSpecialValue) then +! + noraftab(1:nbdim) = child % root_var % interptab(1:nbdim) == 'N' +! + if (.not.associated(parentvalues)) allocate(parentvalues) +! + call Agrif_array_allocate(parentvalues,indmin,indmax,nbdim) + call Agrif_var_full_copy_array(parentvalues,tempPextend,nbdim) +! + call Agrif_CheckMasknD(tempPextend,parentvalues, & + indmin(1:nbdim),indmax(1:nbdim), & + indmin(1:nbdim),indmax(1:nbdim), & + noraftab(1:nbdim),nbdim) +! + call Agrif_array_deallocate(parentvalues,nbdim) +! + endif +! +! Interpolation of the current grid +! + if ( memberin ) then + select case(nbdim) + case(1) + call Agrif_Interp_1D_recursive( type_interp(1), & + tempPextend%array1, & + tempC%array1, & + indmin(1), indmax(1), & + pttruetab(1), cetruetab(1), & + s_Child_temp(1), s_Parent_temp(1), & + ds_Child(1), ds_Parent(1) ) + case(2) + call Agrif_Interp_2D_recursive( type_interp(1:2), & + tempPextend % array2, & + tempC % array2, & + indmin(1:2), indmax(1:2), & + pttruetab(1:2), cetruetab(1:2), & + s_Child_temp(1:2), s_Parent_temp(1:2), & + ds_Child(1:2), ds_Parent(1:2) ) + case(3) + call Agrif_Interp_3D_recursive( type_interp(1:3), & + tempPextend % array3, & + tempC % array3, & + indmin(1:3), indmax(1:3), & + pttruetab(1:3), cetruetab(1:3), & + s_Child_temp(1:3), s_Parent_temp(1:3), & + ds_Child(1:3), ds_Parent(1:3) ) + case(4) + call Agrif_Interp_4D_recursive( type_interp(1:4), & + tempPextend % array4, & + tempC % array4, & + indmin(1:4), indmax(1:4), & + pttruetab(1:4), cetruetab(1:4), & + s_Child_temp(1:4), s_Parent_temp(1:4), & + ds_Child(1:4), ds_Parent(1:4) ) + case(5) + call Agrif_Interp_5D_recursive( type_interp(1:5), & + tempPextend % array5, & + tempC % array5, & + indmin(1:5), indmax(1:5), & + pttruetab(1:5), cetruetab(1:5), & + s_Child_temp(1:5), s_Parent_temp(1:5), & + ds_Child(1:5), ds_Parent(1:5) ) + case(6) + call Agrif_Interp_6D_recursive( type_interp(1:6), & + tempPextend % array6, & + tempC % array6, & + indmin(1:6), indmax(1:6), & + pttruetab(1:6), cetruetab(1:6), & + s_Child_temp(1:6), s_Parent_temp(1:6), & + ds_Child(1:6), ds_Parent(1:6) ) + end select +! + call Agrif_get_var_bounds_array(child,lowerbound,upperbound,nbdim) + +#if defined AGRIF_MPI + call Agrif_GlobalToLocalBounds(childarray, lowerbound, upperbound, & + pttruetab, cetruetab, coords, & + nbdim, Agrif_Procrank, memberout) +#else + childarray(:,1,1) = pttruetab + childarray(:,2,1) = cetruetab + childarray(:,1,2) = pttruetab + childarray(:,2,2) = cetruetab +!cccccccccccccc memberout = .TRUE. +#endif +! +! Special values on the child grid + if (Agrif_UseSpecialValueFineGrid) then + call GiveAgrif_SpecialValueToTab_mpi( child, tempC, childarray, Agrif_SpecialValueFineGrid,nbdim ) + endif +! + endif ! ( memberin ) +! + if (torestore) then +! +#if defined AGRIF_MPI +! + SELECT CASE (nbdim) + CASE (1) + do i = pttruetab(1),cetruetab(1) +!hildarrayAModifier if (restore%restore1D(i) == 0) & +!hildarrayAModifier child%array1(childarray(i,1,2)) = tempC%array1(i) + enddo + CASE (2) + do i = pttruetab(1),cetruetab(1) + do j = pttruetab(2),cetruetab(2) +!hildarrayAModifier if (restore%restore2D(i,j) == 0) & +!hildarrayAModifier child%array2(childarray(i,1,2), & +!hildarrayAModifier childarray(j,2,2)) = tempC%array2(i,j) + enddo + enddo + CASE (3) + do i = pttruetab(1),cetruetab(1) + do j = pttruetab(2),cetruetab(2) + do k = pttruetab(3),cetruetab(3) +!hildarrayAModifier if (restore%restore3D(i,j,k) == 0) & +!hildarrayAModifier child%array3(childarray(i,1,2), & +!hildarrayAModifier childarray(j,2,2), & +!hildarrayAModifier childarray(k,3,2)) = tempC%array3(i,j,k) + enddo + enddo + enddo + CASE (4) + do i = pttruetab(1),cetruetab(1) + do j = pttruetab(2),cetruetab(2) + do k = pttruetab(3),cetruetab(3) + do l = pttruetab(4),cetruetab(4) +!hildarrayAModifier if (restore%restore4D(i,j,k,l) == 0) & +!hildarrayAModifier child%array4(childarray(i,1,2), & +!hildarrayAModifier childarray(j,2,2), & +!hildarrayAModifier childarray(k,3,2), & +!hildarrayAModifier childarray(l,4,2)) = tempC%array4(i,j,k,l) + enddo + enddo + enddo + enddo + CASE (5) + do i = pttruetab(1),cetruetab(1) + do j = pttruetab(2),cetruetab(2) + do k = pttruetab(3),cetruetab(3) + do l = pttruetab(4),cetruetab(4) + do m = pttruetab(5),cetruetab(5) +!hildarrayAModifier if (restore%restore5D(i,j,k,l,m) == 0) & +!hildarrayAModifier child%array5(childarray(i,1,2), & +!hildarrayAModifier childarray(j,2,2), & +!hildarrayAModifier childarray(k,3,2), & +!hildarrayAModifier childarray(l,4,2), & +!hildarrayAModifier childarray(m,5,2)) = tempC%array5(i,j,k,l,m) + enddo + enddo + enddo + enddo + enddo + CASE (6) + do i = pttruetab(1),cetruetab(1) + do j = pttruetab(2),cetruetab(2) + do k = pttruetab(3),cetruetab(3) + do l = pttruetab(4),cetruetab(4) + do m = pttruetab(5),cetruetab(5) + do n = pttruetab(6),cetruetab(6) +!hildarrayAModifier if (restore%restore6D(i,j,k,l,m,n) == 0) & +!hildarrayAModifier child%array6(childarray(i,1,2), & +!hildarrayAModifier childarray(j,2,2), & +!hildarrayAModifier childarray(k,3,2), & +!hildarrayAModifier childarray(l,4,2), & +!hildarrayAModifier childarray(m,5,2), & +!hildarrayAModifier childarray(n,6,2)) = tempC%array6(i,j,k,l,m,n) + enddo + enddo + enddo + enddo + enddo + enddo + END SELECT +! +#else + select case (nbdim) + case (1) + do i = pttruetab(1),cetruetab(1) + if (restore%restore1D(i) == 0) & + parray1(i) = tempC % array1(i) + enddo + case (2) + do j = pttruetab(2),cetruetab(2) + do i = pttruetab(1),cetruetab(1) + if (restore%restore2D(i,j) == 0) & + parray2(i,j) = tempC % array2(i,j) + enddo + enddo + case (3) + do k = pttruetab(3),cetruetab(3) + do j = pttruetab(2),cetruetab(2) + do i = pttruetab(1),cetruetab(1) + if (restore%restore3D(i,j,k) == 0) & + parray3(i,j,k) = tempC % array3(i,j,k) + enddo + enddo + enddo + case (4) + do l = pttruetab(4),cetruetab(4) + do k = pttruetab(3),cetruetab(3) + do j = pttruetab(2),cetruetab(2) + do i = pttruetab(1),cetruetab(1) + if (restore%restore4D(i,j,k,l) == 0) & + parray4(i,j,k,l) = tempC % array4(i,j,k,l) + enddo + enddo + enddo + enddo + case (5) + do m = pttruetab(5),cetruetab(5) + do l = pttruetab(4),cetruetab(4) + do k = pttruetab(3),cetruetab(3) + do j = pttruetab(2),cetruetab(2) + do i = pttruetab(1),cetruetab(1) + if (restore%restore5D(i,j,k,l,m) == 0) & + parray5(i,j,k,l,m) = tempC % array5(i,j,k,l,m) + enddo + enddo + enddo + enddo + enddo + case (6) + do n = pttruetab(6),cetruetab(6) + do m = pttruetab(5),cetruetab(5) + do l = pttruetab(4),cetruetab(4) + do k = pttruetab(3),cetruetab(3) + do j = pttruetab(2),cetruetab(2) + do i = pttruetab(1),cetruetab(1) + if (restore%restore6D(i,j,k,l,m,n) == 0) & + parray6(i,j,k,l,m,n) = tempC % array6(i,j,k,l,m,n) + enddo + enddo + enddo + enddo + enddo + enddo + end select +! +#endif +! + else ! .not.to_restore +! + if (memberin) then + ! + if ( .not.in_bc ) then + select case(nbdim) + case(1) + call procname(tempC % array1( & + childarray(1,1,1):childarray(1,2,1)), & + childarray(1,1,2),childarray(1,2,2),.FALSE.,nb,ndir) + case(2) + call procname( & + tempC % array2( & + childarray(1,1,1):childarray(1,2,1), & + childarray(2,1,1):childarray(2,2,1)), & + childarray(1,1,2),childarray(1,2,2), & + childarray(2,1,2),childarray(2,2,2),.FALSE.,nb,ndir) + case(3) + call procname( & + tempC % array3( & + childarray(1,1,1):childarray(1,2,1), & + childarray(2,1,1):childarray(2,2,1), & + childarray(3,1,1):childarray(3,2,1)), & + childarray(1,1,2),childarray(1,2,2), & + childarray(2,1,2),childarray(2,2,2), & + childarray(3,1,2),childarray(3,2,2),.FALSE.,nb,ndir) + case(4) + call procname( & + tempC % array4( & + childarray(1,1,1):childarray(1,2,1), & + childarray(2,1,1):childarray(2,2,1), & + childarray(3,1,1):childarray(3,2,1), & + childarray(4,1,1):childarray(4,2,1)), & + childarray(1,1,2),childarray(1,2,2), & + childarray(2,1,2),childarray(2,2,2), & + childarray(3,1,2),childarray(3,2,2), & + childarray(4,1,2),childarray(4,2,2),.FALSE.,nb,ndir) + case(5) + call procname( & + tempC % array5( & + childarray(1,1,1):childarray(1,2,1), & + childarray(2,1,1):childarray(2,2,1), & + childarray(3,1,1):childarray(3,2,1), & + childarray(4,1,1):childarray(4,2,1), & + childarray(5,1,1):childarray(5,2,1)), & + childarray(1,1,2),childarray(1,2,2), & + childarray(2,1,2),childarray(2,2,2), & + childarray(3,1,2),childarray(3,2,2), & + childarray(4,1,2),childarray(4,2,2), & + childarray(5,1,2),childarray(5,2,2),.FALSE.,nb,ndir) + case(6) + call procname( & + tempC % array6( & + childarray(1,1,1):childarray(1,2,1), & + childarray(2,1,1):childarray(2,2,1), & + childarray(3,1,1):childarray(3,2,1), & + childarray(4,1,1):childarray(4,2,1), & + childarray(5,1,1):childarray(5,2,1), & + childarray(6,1,1):childarray(6,2,1)), & + childarray(1,1,2),childarray(1,2,2), & + childarray(2,1,2),childarray(2,2,2), & + childarray(3,1,2),childarray(3,2,2), & + childarray(4,1,2),childarray(4,2,2), & + childarray(5,1,2),childarray(5,2,2), & + childarray(6,1,2),childarray(6,2,2),.FALSE.,nb,ndir) + end select + else ! we are in_bc + select case (nbdim) + case (1) + parray1(childarray(1,1,2):childarray(1,2,2)) = & + tempC%array1(childarray(1,1,1):childarray(1,2,1)) + case (2) + parray2(childarray(1,1,2):childarray(1,2,2), & + childarray(2,1,2):childarray(2,2,2)) = & + tempC%array2(childarray(1,1,1):childarray(1,2,1), & + childarray(2,1,1):childarray(2,2,1)) + case (3) + parray3(childarray(1,1,2):childarray(1,2,2), & + childarray(2,1,2):childarray(2,2,2), & + childarray(3,1,2):childarray(3,2,2)) = & + tempC%array3(childarray(1,1,1):childarray(1,2,1), & + childarray(2,1,1):childarray(2,2,1), & + childarray(3,1,1):childarray(3,2,1)) + case (4) + parray4(childarray(1,1,2):childarray(1,2,2), & + childarray(2,1,2):childarray(2,2,2), & + childarray(3,1,2):childarray(3,2,2), & + childarray(4,1,2):childarray(4,2,2)) = & + tempC%array4(childarray(1,1,1):childarray(1,2,1), & + childarray(2,1,1):childarray(2,2,1), & + childarray(3,1,1):childarray(3,2,1), & + childarray(4,1,1):childarray(4,2,1)) + case (5) + parray5(childarray(1,1,2):childarray(1,2,2), & + childarray(2,1,2):childarray(2,2,2), & + childarray(3,1,2):childarray(3,2,2), & + childarray(4,1,2):childarray(4,2,2), & + childarray(5,1,2):childarray(5,2,2)) = & + tempC%array5(childarray(1,1,1):childarray(1,2,1), & + childarray(2,1,1):childarray(2,2,1), & + childarray(3,1,1):childarray(3,2,1), & + childarray(4,1,1):childarray(4,2,1), & + childarray(5,1,1):childarray(5,2,1)) + case (6) + parray6(childarray(1,1,2):childarray(1,2,2), & + childarray(2,1,2):childarray(2,2,2), & + childarray(3,1,2):childarray(3,2,2), & + childarray(4,1,2):childarray(4,2,2), & + childarray(5,1,2):childarray(5,2,2), & + childarray(6,1,2):childarray(6,2,2)) = & + tempC%array6(childarray(1,1,1):childarray(1,2,1), & + childarray(2,1,1):childarray(2,2,1), & + childarray(3,1,1):childarray(3,2,1), & + childarray(4,1,1):childarray(4,2,1), & + childarray(5,1,1):childarray(5,2,1), & + childarray(6,1,1):childarray(6,2,1)) + end select + endif ! < (.not.in_bc) + endif ! < memberin +! + endif + + call Agrif_array_deallocate(tempPextend,nbdim) + call Agrif_array_deallocate(tempC,nbdim) + + endif +! +! Deallocations +#if defined AGRIF_MPI + if (member) then + call Agrif_array_deallocate(tempP,nbdim) + endif +#endif +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_InterpnD +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Parentbounds +! +!> Calculates the bounds of the parent grid for the interpolation of the child grid +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Parentbounds ( type_interp, nbdim, indmin, indmax, & + s_Parent_temp, s_Child_temp, & + s_Child, ds_Child, & + s_Parent,ds_Parent, & + pttruetab, cetruetab, & + pttab_Child, pttab_Parent, posvar, coords ) +!--------------------------------------------------------------------------------------------------- + INTEGER, DIMENSION(6), intent(in) :: type_interp + INTEGER, intent(in) :: nbdim + INTEGER, DIMENSION(nbdim), intent(out) :: indmin, indmax + REAL, DIMENSION(nbdim), intent(out) :: s_Parent_temp, s_child_temp + REAL, DIMENSION(nbdim), intent(in) :: s_Child, ds_child + REAL, DIMENSION(nbdim), intent(in) :: s_Parent,ds_Parent + INTEGER, DIMENSION(nbdim), intent(in) :: pttruetab, cetruetab + INTEGER, DIMENSION(nbdim), intent(in) :: pttab_Child, pttab_Parent + INTEGER, DIMENSION(nbdim), intent(in) :: posvar + INTEGER, DIMENSION(nbdim), intent(in) :: coords +! + INTEGER :: i + REAL,DIMENSION(nbdim) :: dim_newmin, dim_newmax +! + dim_newmin = s_Child + (pttruetab - pttab_Child) * ds_Child + dim_newmax = s_Child + (cetruetab - pttab_Child) * ds_Child +! + do i = 1,nbdim +! + indmin(i) = pttab_Parent(i) + agrif_int((dim_newmin(i)-s_Parent(i))/ds_Parent(i)) + indmax(i) = pttab_Parent(i) + agrif_ceiling((dim_newmax(i)-s_Parent(i))/ds_Parent(i)) +! +! Necessary for the Quadratic interpolation +! + if ( (pttruetab(i) == cetruetab(i)) .and. (posvar(i) == 1) ) then + elseif ( coords(i) == 0 ) then ! (interptab == 'N') + elseif ( (type_interp(i) == Agrif_ppm) .or. & + (type_interp(i) == Agrif_eno) .or. & + (type_interp(i) == Agrif_ppm_lim) .or. & + (type_interp(i) == Agrif_weno) ) then + indmin(i) = indmin(i) - 2 + indmax(i) = indmax(i) + 2 + elseif ( (type_interp(i) /= Agrif_constant) .and. & + (type_interp(i) /= Agrif_linear) ) then + indmin(i) = indmin(i) - 1 + indmax(i) = indmax(i) + 1 + endif +! + enddo +! + s_Parent_temp = s_Parent + (indmin - pttab_Parent) * ds_Parent + s_Child_temp = s_Child + (pttruetab - pttab_Child) * ds_Child +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Parentbounds +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Interp_1D_Recursive +! +!> Subroutine for the interpolation of a 1D grid variable. +!> It calls Agrif_InterpBase. +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Interp_1D_recursive ( type_interp, tabin, tabout, & + indmin, indmax, & + pttab_child, petab_child, & + s_child, s_parent, & + ds_child, ds_parent ) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: type_interp + integer, intent(in) :: indmin, indmax + integer, intent(in) :: pttab_child, petab_child + real, intent(in) :: s_child, s_parent + real, intent(in) :: ds_child, ds_parent + real, dimension( & + indmin:indmax & + ), intent(in) :: tabin + real, dimension( & + pttab_child:petab_child & + ), intent(out) :: tabout +!--------------------------------------------------------------------------------------------------- + call Agrif_InterpBase(type_interp, & + tabin(indmin:indmax), & + tabout(pttab_child:petab_child), & + indmin, indmax, & + pttab_child, petab_child, & + s_parent, s_child, & + ds_parent, ds_child) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Interp_1D_recursive +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Interp_2D_Recursive +! +!> Subroutine for the interpolation of a 2D grid variable. +!> It calls Agrif_Interp_1D_recursive and Agrif_InterpBase. +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Interp_2D_recursive ( type_interp, tabin, tabout, & + indmin, indmax, & + pttab_child, petab_child, & + s_child, s_parent, & + ds_child, ds_parent ) +!--------------------------------------------------------------------------------------------------- + integer, dimension(2), intent(in) :: type_interp + integer, dimension(2), intent(in) :: indmin, indmax + integer, dimension(2), intent(in) :: pttab_child, petab_child + real, dimension(2), intent(in) :: s_child, s_parent + real, dimension(2), intent(in) :: ds_child, ds_parent + real, dimension( & + indmin(1):indmax(1), & + indmin(2):indmax(2)), intent(in) :: tabin + real, dimension( & + pttab_child(1):petab_child(1), & + pttab_child(2):petab_child(2)), intent(out) :: tabout +!--------------------------------------------------------------------------------------------------- + real, dimension( & + pttab_child(1):petab_child(1), & + indmin(2):indmax(2)) :: tabtemp + real, dimension( & + pttab_child(2):petab_child(2), & + pttab_child(1):petab_child(1)) :: tabout_trsp + real, dimension( & + indmin(2):indmax(2), & + pttab_child(1):petab_child(1)) :: tabtemp_trsp + integer :: i, j, coeffraf +!--------------------------------------------------------------------------------------------------- +! + coeffraf = nint ( ds_parent(1) / ds_child(1) ) +! + if ((type_interp(1) == Agrif_Linear) .and. (coeffraf /= 1)) then +!---CDIR NEXPAND + if(.NOT. precomputedone(1)) & + call Linear1dPrecompute2d( & + indmax(2)-indmin(2)+1, & + indmax(1)-indmin(1)+1, & + petab_child(1)-pttab_child(1)+1, & + s_parent(1),s_child(1),ds_parent(1),ds_child(1),1) +!---CDIR NEXPAND + call Linear1dAfterCompute(tabin,tabtemp,size(tabin),size(tabtemp),1) +! + elseif ((type_interp(1) == Agrif_PPM) .and. (coeffraf /= 1)) then +!---CDIR NEXPAND + if(.NOT. precomputedone(1)) & + call PPM1dPrecompute2d( & + indmax(2)-indmin(2)+1, & + indmax(1)-indmin(1)+1, & + petab_child(1)-pttab_child(1)+1, & + s_parent(1),s_child(1),ds_parent(1),ds_child(1),1) +!---CDIR NEXPAND + call PPM1dAfterCompute(tabin,tabtemp,size(tabin),size(tabtemp),1) + else + do j = indmin(2),indmax(2) +! +!---CDIR NEXPAND + call Agrif_Interp_1D_recursive(type_interp(1), & + tabin(indmin(1):indmax(1),j), & + tabtemp(pttab_child(1):petab_child(1),j), & + indmin(1),indmax(1), & + pttab_child(1),petab_child(1), & + s_child(1), s_parent(1), & + ds_child(1),ds_parent(1)) +! + enddo + endif + + coeffraf = nint(ds_parent(2)/ds_child(2)) + tabtemp_trsp = TRANSPOSE(tabtemp) + + if ((type_interp(2) == Agrif_Linear) .and. (coeffraf /= 1)) then +!---CDIR NEXPAND + if(.NOT. precomputedone(2)) & + call Linear1dPrecompute2d( & + petab_child(1)-pttab_child(1)+1, & + indmax(2)-indmin(2)+1, & + petab_child(2)-pttab_child(2)+1, & + s_parent(2),s_child(2),ds_parent(2),ds_child(2),2) +!---CDIR NEXPAND + call Linear1dAfterCompute(tabtemp_trsp,tabout_trsp, & + size(tabtemp_trsp),size(tabout_trsp),2) + + elseif ((type_interp(2) == Agrif_PPM) .and. (coeffraf /= 1)) then +!---CDIR NEXPAND + if(.NOT. precomputedone(2)) & + call PPM1dPrecompute2d( & + petab_child(1)-pttab_child(1)+1, & + indmax(2)-indmin(2)+1, & + petab_child(2)-pttab_child(2)+1, & + s_parent(2),s_child(2),ds_parent(2),ds_child(2),2) +!---CDIR NEXPAND + call PPM1dAfterCompute(tabtemp_trsp, tabout_trsp, & + size(tabtemp_trsp), size(tabout_trsp), 2) + else + do i = pttab_child(1), petab_child(1) +! +!---CDIR NEXPAND + call Agrif_InterpBase(type_interp(2), & + tabtemp_trsp(indmin(2):indmax(2), i), & + tabout_trsp(pttab_child(2):petab_child(2), i), & + indmin(2), indmax(2), & + pttab_child(2), petab_child(2), & + s_parent(2), s_child(2), & + ds_parent(2), ds_child(2) ) + enddo + endif +! + tabout = TRANSPOSE(tabout_trsp) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Interp_2D_recursive +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Interp_3D_Recursive +! +!> Subroutine for the interpolation of a 3D grid variable. +!> It calls #Agrif_Interp_2D_recursive and #Agrif_InterpBase. +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Interp_3D_recursive ( type_interp, tabin, tabout, & + indmin, indmax, & + pttab_child, petab_child, & + s_child, s_parent, & + ds_child, ds_parent ) +!--------------------------------------------------------------------------------------------------- + integer, dimension(3), intent(in) :: type_interp + integer, dimension(3), intent(in) :: indmin, indmax + integer, dimension(3), intent(in) :: pttab_child, petab_child + real, dimension(3), intent(in) :: s_child, s_parent + real, dimension(3), intent(in) :: ds_child, ds_parent + real, dimension( & + indmin(1):indmax(1), & + indmin(2):indmax(2), & + indmin(3):indmax(3)), intent(in) :: tabin + real, dimension( & + pttab_child(1):petab_child(1), & + pttab_child(2):petab_child(2), & + pttab_child(3):petab_child(3)), intent(out) :: tabout +!--------------------------------------------------------------------------------------------------- + real, dimension( & + pttab_child(1):petab_child(1), & + pttab_child(2):petab_child(2), & + indmin(3):indmax(3)) :: tabtemp + integer :: i, j, k, coeffraf + integer :: locind_child_left, kdeb +! + coeffraf = nint ( ds_parent(1) / ds_child(1) ) + if ( (type_interp(1) == Agrif_Linear) .and. (coeffraf/=1) ) then + call Linear1dPrecompute2d(indmax(2)-indmin(2)+1, & + indmax(1)-indmin(1)+1, & + petab_child(1)-pttab_child(1)+1, & + s_parent(1),s_child(1),ds_parent(1),ds_child(1),1) + precomputedone(1) = .TRUE. + elseif ( (type_interp(1) == Agrif_PPM) .and. (coeffraf/=1) ) then + call PPM1dPrecompute2d(indmax(2)-indmin(2)+1, & + indmax(1)-indmin(1)+1, & + petab_child(1)-pttab_child(1)+1, & + s_parent(1),s_child(1),ds_parent(1),ds_child(1),1) + precomputedone(1) = .TRUE. + endif + + coeffraf = nint ( ds_parent(2) / ds_child(2) ) + if ( (type_interp(2) == Agrif_Linear) .and. (coeffraf/=1) ) then + call Linear1dPrecompute2d(petab_child(1)-pttab_child(1)+1, & + indmax(2)-indmin(2)+1, & + petab_child(2)-pttab_child(2)+1, & + s_parent(2),s_child(2),ds_parent(2),ds_child(2),2) + precomputedone(2) = .TRUE. + elseif ( (type_interp(2) == Agrif_PPM) .and. (coeffraf/=1) ) then + call PPM1dPrecompute2d(petab_child(1)-pttab_child(1)+1, & + indmax(2)-indmin(2)+1, & + petab_child(2)-pttab_child(2)+1, & + s_parent(2),s_child(2),ds_parent(2),ds_child(2),2) + precomputedone(2) = .TRUE. + endif +! + do k = indmin(3), indmax(3) + call Agrif_Interp_2D_recursive(type_interp(1:2), & + tabin(indmin(1):indmax(1), & + indmin(2):indmax(2), k), & + tabtemp(pttab_child(1):petab_child(1), & + pttab_child(2):petab_child(2), k), & + indmin(1:2), indmax(1:2), & + pttab_child(1:2), petab_child(1:2), & + s_child(1:2), s_parent(1:2), & + ds_child(1:2), ds_parent(1:2) ) + enddo +! + precomputedone(1) = .FALSE. + precomputedone(2) = .FALSE. + coeffraf = nint(ds_parent(3)/ds_child(3)) +! + if ( coeffraf == 1 ) then + locind_child_left = 1 + agrif_int((s_child(3)-s_parent(3))/ds_parent(3)) + kdeb = indmin(3)+locind_child_left-2 + do k = pttab_child(3),petab_child(3) + kdeb = kdeb + 1 + do j = pttab_child(2), petab_child(2) + do i = pttab_child(1), petab_child(1) + tabout(i,j,k) = tabtemp(i,j,kdeb) + enddo + enddo + enddo + else + do j = pttab_child(2), petab_child(2) + do i = pttab_child(1), petab_child(1) + call Agrif_InterpBase(type_interp(3), & + tabtemp(i,j,indmin(3):indmax(3)), & + tabout(i,j,pttab_child(3):petab_child(3)), & + indmin(3), indmax(3), & + pttab_child(3), petab_child(3), & + s_parent(3), s_child(3), & + ds_parent(3), ds_child(3) ) + enddo + enddo + endif +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Interp_3D_recursive +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Interp_4D_Recursive +! +!> Subroutine for the interpolation of a 4D grid variable. +!> It calls #Agrif_Interp_3D_recursive and #Agrif_InterpBase. +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Interp_4D_recursive ( type_interp, tabin, tabout, & + indmin, indmax, & + pttab_child, petab_child, & + s_child, s_parent, & + ds_child, ds_parent ) +!--------------------------------------------------------------------------------------------------- + integer, dimension(4), intent(in) :: type_interp + integer, dimension(4), intent(in) :: indmin, indmax + integer, dimension(4), intent(in) :: pttab_child, petab_child + real, dimension(4), intent(in) :: s_child, s_parent + real, dimension(4), intent(in) :: ds_child, ds_parent + real, dimension( & + indmin(1):indmax(1), & + indmin(2):indmax(2), & + indmin(3):indmax(3), & + indmin(4):indmax(4)), intent(in) :: tabin + real, dimension( & + pttab_child(1):petab_child(1), & + pttab_child(2):petab_child(2), & + pttab_child(3):petab_child(3), & + pttab_child(4):petab_child(4)), intent(out) :: tabout +!--------------------------------------------------------------------------------------------------- + real, dimension( & + pttab_child(1):petab_child(1), & + pttab_child(2):petab_child(2), & + pttab_child(3):petab_child(3), & + indmin(4):indmax(4)) :: tabtemp + integer :: i, j, k, l +! + do l = indmin(4), indmax(4) + call Agrif_Interp_3D_recursive(type_interp(1:3), & + tabin(indmin(1):indmax(1), & + indmin(2):indmax(2), & + indmin(3):indmax(3), l), & + tabtemp(pttab_child(1):petab_child(1), & + pttab_child(2):petab_child(2), & + pttab_child(3):petab_child(3), l), & + indmin(1:3), indmax(1:3), & + pttab_child(1:3), petab_child(1:3), & + s_child(1:3), s_parent(1:3), & + ds_child(1:3), ds_parent(1:3) ) + enddo +! + do k = pttab_child(3), petab_child(3) + do j = pttab_child(2), petab_child(2) + do i = pttab_child(1), petab_child(1) + call Agrif_InterpBase(type_interp(4), & + tabtemp(i,j,k,indmin(4):indmax(4)), & + tabout(i,j,k,pttab_child(4):petab_child(4)), & + indmin(4), indmax(4), & + pttab_child(4), petab_child(4), & + s_parent(4), s_child(4), & + ds_parent(4), ds_child(4) ) + enddo + enddo + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Interp_4D_recursive +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Interp_5D_Recursive +! +!> Subroutine for the interpolation of a 5D grid variable. +!> It calls #Agrif_Interp_4D_recursive and #Agrif_InterpBase. +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Interp_5D_recursive ( type_interp, tabin, tabout, & + indmin, indmax, & + pttab_child, petab_child, & + s_child, s_parent, & + ds_child, ds_parent ) +!--------------------------------------------------------------------------------------------------- + integer, dimension(5), intent(in) :: type_interp + integer, dimension(5), intent(in) :: indmin, indmax + integer, dimension(5), intent(in) :: pttab_child, petab_child + real, dimension(5), intent(in) :: s_child, s_parent + real, dimension(5), intent(in) :: ds_child, ds_parent + real, dimension( & + indmin(1):indmax(1), & + indmin(2):indmax(2), & + indmin(3):indmax(3), & + indmin(4):indmax(4), & + indmin(5):indmax(5)), intent(in) :: tabin + real, dimension( & + pttab_child(1):petab_child(1), & + pttab_child(2):petab_child(2), & + pttab_child(3):petab_child(3), & + pttab_child(4):petab_child(4), & + pttab_child(5):petab_child(5)), intent(out) :: tabout +!--------------------------------------------------------------------------------------------------- + real, dimension( & + pttab_child(1):petab_child(1), & + pttab_child(2):petab_child(2), & + pttab_child(3):petab_child(3), & + pttab_child(4):petab_child(4), & + indmin(5):indmax(5)) :: tabtemp + integer :: i, j, k, l, m +! + do m = indmin(5), indmax(5) + call Agrif_Interp_4D_recursive(type_interp(1:4), & + tabin(indmin(1):indmax(1), & + indmin(2):indmax(2), & + indmin(3):indmax(3), & + indmin(4):indmax(4),m), & + tabtemp(pttab_child(1):petab_child(1), & + pttab_child(2):petab_child(2), & + pttab_child(3):petab_child(3), & + pttab_child(4):petab_child(4), m), & + indmin(1:4),indmax(1:4), & + pttab_child(1:4), petab_child(1:4), & + s_child(1:4), s_parent(1:4), & + ds_child(1:4), ds_parent(1:4) ) + enddo +! + do l = pttab_child(4), petab_child(4) + do k = pttab_child(3), petab_child(3) + do j = pttab_child(2), petab_child(2) + do i = pttab_child(1), petab_child(1) + call Agrif_InterpBase(type_interp(5), & + tabtemp(i,j,k,l,indmin(5):indmax(5)), & + tabout(i,j,k,l,pttab_child(5):petab_child(5)), & + indmin(5), indmax(5), & + pttab_child(5), petab_child(5), & + s_parent(5), s_child(5), & + ds_parent(5), ds_child(5) ) + enddo + enddo + enddo + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Interp_5D_recursive +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Interp_6D_Recursive +! +!> Subroutine for the interpolation of a 6D grid variable. +!> It calls #Agrif_Interp_5D_recursive and Agrif_InterpBase. +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Interp_6D_recursive ( type_interp, tabin, tabout, & + indmin, indmax, & + pttab_child, petab_child, & + s_child, s_parent, & + ds_child, ds_parent ) +!--------------------------------------------------------------------------------------------------- + integer, dimension(6), intent(in) :: type_interp + integer, dimension(6), intent(in) :: indmin, indmax + integer, dimension(6), intent(in) :: pttab_child, petab_child + real, dimension(6), intent(in) :: s_child, s_parent + real, dimension(6), intent(in) :: ds_child, ds_parent + real, dimension( & + indmin(1):indmax(1), & + indmin(2):indmax(2), & + indmin(3):indmax(3), & + indmin(4):indmax(4), & + indmin(5):indmax(5), & + indmin(6):indmax(6)), intent(in) :: tabin + real, dimension( & + pttab_child(1):petab_child(1), & + pttab_child(2):petab_child(2), & + pttab_child(3):petab_child(3), & + pttab_child(4):petab_child(4), & + pttab_child(5):petab_child(5), & + pttab_child(6):petab_child(6)), intent(out) :: tabout +!--------------------------------------------------------------------------------------------------- + real, dimension( & + pttab_child(1):petab_child(1), & + pttab_child(2):petab_child(2), & + pttab_child(3):petab_child(3), & + pttab_child(4):petab_child(4), & + pttab_child(5):petab_child(5), & + indmin(6):indmax(6)) :: tabtemp + integer :: i, j, k, l, m, n +! + do n = indmin(6), indmax(6) + call Agrif_Interp_5D_recursive(type_interp(1:5), & + tabin(indmin(1):indmax(1), & + indmin(2):indmax(2), & + indmin(3):indmax(3), & + indmin(4):indmax(4), & + indmin(5):indmax(5), n), & + tabtemp(pttab_child(1):petab_child(1), & + pttab_child(2):petab_child(2), & + pttab_child(3):petab_child(3), & + pttab_child(4):petab_child(4), & + pttab_child(5):petab_child(5), n), & + indmin(1:5),indmax(1:5), & + pttab_child(1:5), petab_child(1:5), & + s_child(1:5), s_parent(1:5), & + ds_child(1:5),ds_parent(1:5) ) + enddo +! + do m = pttab_child(5), petab_child(5) + do l = pttab_child(4), petab_child(4) + do k = pttab_child(3), petab_child(3) + do j = pttab_child(2), petab_child(2) + do i = pttab_child(1), petab_child(1) + call Agrif_InterpBase(type_interp(6), & + tabtemp(i,j,k,l,m,indmin(6):indmax(6)), & + tabout(i,j,k,l,m,pttab_child(6):petab_child(6)), & + indmin(6), indmax(6), & + pttab_child(6), petab_child(6), & + s_parent(6), s_child(6), & + ds_parent(6), ds_child(6) ) + enddo + enddo + enddo + enddo + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Interp_6D_recursive +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_InterpBase +! +!> Calls the interpolation method chosen by the user (linear, lagrange, spline, etc.). +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_InterpBase ( type_interp, parenttab, childtab, indmin, indmax, & + pttab_child, petab_child, & + s_parent, s_child, ds_parent, ds_child ) +!--------------------------------------------------------------------------------------------------- + INTEGER :: type_interp + INTEGER :: indmin, indmax + INTEGER :: pttab_child, petab_child + REAL, DIMENSION(indmin:indmax), INTENT(IN) :: parenttab + REAL, DIMENSION(pttab_child:petab_child), INTENT(OUT) :: childtab + REAL :: s_parent, s_child + REAL :: ds_parent,ds_child +! + if ( (indmin == indmax) .and. (pttab_child == petab_child) ) then +! + childtab(pttab_child) = parenttab(indmin) +! + elseif (type_interp == Agrif_LINEAR) then ! Linear interpolation +! + call Agrif_basicinterp_linear1D(parenttab,childtab, & + indmax-indmin+1,petab_child-pttab_child+1, & + s_parent,s_child,ds_parent,ds_child) +! + elseif ( type_interp == Agrif_PPM ) then ! PPM interpolation + + call PPM1d(parenttab,childtab, & + indmax-indmin+1,petab_child-pttab_child+1, & + s_parent,s_child,ds_parent,ds_child) +! + elseif ( type_interp == Agrif_PPM_LIM ) then ! PPM interpolation + + call PPM1d_lim(parenttab,childtab, & + indmax-indmin+1,petab_child-pttab_child+1, & + s_parent,s_child,ds_parent,ds_child) +! + elseif (type_interp == Agrif_LAGRANGE) then ! Lagrange interpolation +! + call lagrange1D(parenttab,childtab, & + indmax-indmin+1,petab_child-pttab_child+1, & + s_parent,s_child,ds_parent,ds_child) +! + elseif (type_interp == Agrif_ENO) then ! Eno interpolation +! + call ENO1d(parenttab,childtab, & + indmax-indmin+1,petab_child-pttab_child+1, & + s_parent,s_child,ds_parent,ds_child) +! + elseif (type_interp == Agrif_WENO) then ! Weno interpolation +! + call WENO1d(parenttab,childtab, & + indmax-indmin+1,petab_child-pttab_child+1, & + s_parent,s_child,ds_parent,ds_child) +! + elseif (type_interp == Agrif_LINEARCONSERV) then ! Linear conservative interpolation +! + call Linear1dConserv(parenttab,childtab, & + indmax-indmin+1,petab_child-pttab_child+1, & + s_parent,s_child,ds_parent,ds_child) +! + elseif (type_interp == Agrif_LINEARCONSERVLIM) then !Linear conservative interpolation +! + call Linear1dConservLim(parenttab,childtab, & + indmax-indmin+1,petab_child-pttab_child+1, & + s_parent,s_child,ds_parent,ds_child) +! + elseif (type_interp == Agrif_CONSTANT) then +! + call Constant1d(parenttab,childtab, & + indmax-indmin+1,petab_child-pttab_child+1, & + s_parent,s_child,ds_parent,ds_child) +! + endif +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_InterpBase +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Find_list_interp +!--------------------------------------------------------------------------------------------------- +function Agrif_Find_list_interp ( list_interp, pttab, petab, pttab_Child, pttab_Parent, & + nbdim, indmin, indmax, indminglob, indmaxglob, & + pttruetab, cetruetab, memberin & +#if defined AGRIF_MPI + ,indminglob2, indmaxglob2, parentarray, & + member, tab4t, memberinall, sendtoproc1, recvfromproc1 & +#endif + ) result(find_list_interp) +!--------------------------------------------------------------------------------------------------- + type(Agrif_List_Interp_Loc), pointer :: list_interp + integer, intent(in) :: nbdim + integer, dimension(nbdim), intent(in) :: pttab, petab, pttab_Child, pttab_Parent + integer, dimension(nbdim), intent(out) :: indmin, indmax + integer, dimension(nbdim), intent(out) :: indminglob, indmaxglob + integer, dimension(nbdim), intent(out) :: pttruetab, cetruetab + logical, intent(out) :: memberin +#if defined AGRIF_MPI + integer, dimension(nbdim), intent(out) :: indminglob2, indmaxglob2 + integer, dimension(nbdim,2,2), intent(out) :: parentarray + logical, intent(out) :: member + integer, dimension(nbdim,0:Agrif_Nbprocs-1,8), intent(out) :: tab4t + logical, dimension(0:Agrif_Nbprocs-1), intent(out) :: memberinall + logical, dimension(0:Agrif_Nbprocs-1), intent(out) :: sendtoproc1, recvfromproc1 +#endif + logical :: find_list_interp +! + integer :: i + type(Agrif_List_Interp_Loc), pointer :: parcours + type(Agrif_Interp_Loc), pointer :: pil + + find_list_interp = .false. + + if ( .not. associated(list_interp) ) return + + parcours => list_interp + find_loop : do while ( associated(parcours) ) + + pil => parcours % interp_loc + + do i = 1,nbdim + if ( (pttab(i) /= pil % pttab(i)) .or. & + (petab(i) /= pil % petab(i)) .or. & + (pttab_child(i) /= pil % pttab_child(i)) .or. & + (pttab_parent(i) /= pil % pttab_parent(i)) ) then + parcours => parcours % suiv + cycle find_loop + endif + enddo + + indmin = pil % indmin(1:nbdim) + indmax = pil % indmax(1:nbdim) + + pttruetab = pil % pttruetab(1:nbdim) + cetruetab = pil % cetruetab(1:nbdim) + +#if !defined AGRIF_MPI + indminglob = pil % indminglob(1:nbdim) + indmaxglob = pil % indmaxglob(1:nbdim) +#else + indminglob = pil % indminglob2(1:nbdim) + indmaxglob = pil % indmaxglob2(1:nbdim) + indminglob2 = pil % indminglob2(1:nbdim) + indmaxglob2 = pil % indmaxglob2(1:nbdim) + parentarray = pil % parentarray(1:nbdim,:,:) + member = pil % member + tab4t = pil % tab4t(1:nbdim, 0:Agrif_Nbprocs-1, 1:8) + memberinall = pil % memberinall(0:Agrif_Nbprocs-1) + sendtoproc1 = pil % sendtoproc1(0:Agrif_Nbprocs-1) + recvfromproc1 = pil % recvfromproc1(0:Agrif_Nbprocs-1) +#endif + memberin = pil % memberin + find_list_interp = .true. + exit find_loop + enddo find_loop +!--------------------------------------------------------------------------------------------------- +end function Agrif_Find_list_interp +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_AddTo_list_interp +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_AddTo_list_interp ( list_interp, pttab, petab, pttab_Child, pttab_Parent, & + indmin, indmax, indminglob, indmaxglob, & + pttruetab, cetruetab, & + memberin, nbdim & +#if defined AGRIF_MPI + ,indminglob2, indmaxglob2, & + parentarray, & + member, & + tab4t, memberinall, sendtoproc1, recvfromproc1 & +#endif + ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_List_Interp_Loc), pointer :: list_interp + integer :: nbdim + integer, dimension(nbdim) :: pttab, petab, pttab_Child, pttab_Parent + integer, dimension(nbdim) :: indmin,indmax + integer, dimension(nbdim) :: indminglob, indmaxglob + integer, dimension(nbdim) :: pttruetab, cetruetab + logical :: memberin +#if defined AGRIF_MPI + integer, dimension(nbdim,2,2) :: parentarray + logical :: member + integer, dimension(nbdim) :: indminglob2,indmaxglob2 + integer, dimension(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t + logical, dimension(0:Agrif_Nbprocs-1) :: memberinall + logical, dimension(0:Agrif_Nbprocs-1) :: sendtoproc1 + logical, dimension(0:Agrif_Nbprocs-1) :: recvfromproc1 +#endif +! + type(Agrif_List_Interp_Loc), pointer :: parcours + type(Agrif_Interp_Loc), pointer :: pil +! + allocate(parcours) + allocate(parcours % interp_loc) + + pil => parcours % interp_loc + + pil % pttab(1:nbdim) = pttab(1:nbdim) + pil % petab(1:nbdim) = petab(1:nbdim) + pil % pttab_child(1:nbdim) = pttab_child(1:nbdim) + pil % pttab_parent(1:nbdim) = pttab_parent(1:nbdim) + + pil % indmin(1:nbdim) = indmin(1:nbdim) + pil % indmax(1:nbdim) = indmax(1:nbdim) + + pil % memberin = memberin +#if !defined AGRIF_MPI + pil % indminglob(1:nbdim) = indminglob(1:nbdim) + pil % indmaxglob(1:nbdim) = indmaxglob(1:nbdim) +#else + pil % indminglob2(1:nbdim) = indminglob2(1:nbdim) + pil % indmaxglob2(1:nbdim) = indmaxglob2(1:nbdim) + pil % parentarray(1:nbdim,:,:) = parentarray(1:nbdim,:,:) + pil % member = member + allocate(pil % tab4t(nbdim, 0:Agrif_Nbprocs-1, 8)) + allocate(pil % memberinall(0:Agrif_Nbprocs-1)) + allocate(pil % sendtoproc1(0:Agrif_Nbprocs-1)) + allocate(pil % recvfromproc1(0:Agrif_Nbprocs-1)) + pil % tab4t = tab4t + pil % memberinall = memberinall + pil % sendtoproc1 = sendtoproc1 + pil % recvfromproc1 = recvfromproc1 +#endif + + pil % pttruetab(1:nbdim) = pttruetab(1:nbdim) + pil % cetruetab(1:nbdim) = cetruetab(1:nbdim) + + parcours % suiv => list_interp + list_interp => parcours +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Addto_list_interp +!=================================================================================================== +! +end module Agrif_Interpolation diff --git a/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modinterpbasic.F90 b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modinterpbasic.F90 new file mode 100644 index 00000000..62a9b285 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modinterpbasic.F90 @@ -0,0 +1,1464 @@ +! +! $Id: modinterpbasic.F 779 2007-12-22 17:04:17Z rblod $ +! +! AGRIF (Adaptive Grid Refinement In Fortran) +! +! Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr) +! Christophe Vouland (Christophe.Vouland@imag.fr) +! +! This program is free software; you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation; either version 2 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program; if not, write to the Free Software +! Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA. +! +! +!> Module Agrif_InterpBasic +!> +!> Contains different procedures of interpolation (linear,lagrange, spline,...) used in +!! the Agrif_Interpolation module. +! +module Agrif_InterpBasic +! + use Agrif_Types +! + implicit none +! + real, dimension(5,Agrif_MaxRaff,3) :: tabppm + real, dimension(Agrif_MaxRaff) :: tabdiff2, tabdiff3 + real, dimension(:), allocatable :: tabtest4 + real, dimension(:,:), allocatable :: coeffparent + integer, dimension(:,:), allocatable :: indparent + integer, dimension(:,:), allocatable :: indparentppm, indchildppm + integer, dimension(:), allocatable :: indparentppm_1d, indchildppm_1d +! + private :: Agrif_limiter_vanleer +! +contains +! +!=================================================================================================== +! subroutine Agrif_basicinterp_linear1D +! +!> Linear 1D interpolation on a child grid (vector y) from its parent grid (vector x). +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_basicinterp_linear1D ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child ) +!--------------------------------------------------------------------------------------------------- + real, dimension(np), intent(in) :: x !< Coarse input data from parent + real, dimension(nc), intent(out) :: y !< Fine output data to child + integer, intent(in) :: np !< Length of input array + integer, intent(in) :: nc !< Length of output array + real, intent(in) :: s_parent !< Parent grid position (s_root = 0) + real, intent(in) :: s_child !< Child grid position (s_root = 0) + real, intent(in) :: ds_parent !< Parent grid dx (ds_root = 1) + real, intent(in) :: ds_child !< Child grid dx (ds_root = 1) +! + integer :: i, coeffraf, locind_parent_left + real :: globind_parent_left, globind_parent_right + real :: invds, invds2, ypos, ypos2, diff +! + coeffraf = nint(ds_parent/ds_child) +! + if ( coeffraf == 1 ) then + locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent) + y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1) + return + endif +! + ypos = s_child + locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) + globind_parent_left = s_parent + (locind_parent_left - 1)*ds_parent + globind_parent_right = globind_parent_left + ds_parent +! + invds = 1./ds_parent + invds2 = ds_child/ds_parent + ypos2 = ypos*invds + globind_parent_right = globind_parent_right*invds +! + do i = 1,nc-1 +! + if (ypos2 > globind_parent_right) then + locind_parent_left = locind_parent_left + 1 + globind_parent_right = globind_parent_right + 1. + ypos2 = ypos*invds+(i-1)*invds2 + endif +! + diff = globind_parent_right - ypos2 + y(i) = (diff*x(locind_parent_left) + (1.-diff)*x(locind_parent_left+1)) + ypos2 = ypos2 + invds2 +! + enddo +! + ypos = s_child + (nc-1)*ds_child + locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) +! + if (locind_parent_left == np) then + y(nc) = x(np) + else + globind_parent_left = s_parent + (locind_parent_left - 1)*ds_parent + y(nc) = ((globind_parent_left + ds_parent - ypos)*x(locind_parent_left) & + + (ypos - globind_parent_left)*x(locind_parent_left+1))*invds + endif +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_basicinterp_linear1D +!=================================================================================================== +! +!=================================================================================================== +! subroutine Linear1dPrecompute2d +! +!> Computes 2D coefficients and index for a linear 1D interpolation on a child grid (vector y) +!! from its parent grid (vector x). +!--------------------------------------------------------------------------------------------------- +subroutine Linear1dPrecompute2d ( np2, np, nc, s_parent, s_child, ds_parent, ds_child, dir ) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: np,nc,np2 + real, intent(in) :: s_parent, s_child + real, intent(in) :: ds_parent, ds_child + integer, intent(in) :: dir +! + integer :: i,coeffraf,locind_parent_left,inc,inc1,inc2 + integer, dimension(:,:), allocatable :: indparent_tmp + real, dimension(:,:), allocatable :: coeffparent_tmp + real :: ypos,globind_parent_left,globind_parent_right + real :: invds, invds2, invds3 + real :: ypos2,diff +! + coeffraf = nint(ds_parent/ds_child) +! + ypos = s_child + locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) + globind_parent_left = s_parent + (locind_parent_left - 1)*ds_parent + globind_parent_right = globind_parent_left + ds_parent +! + invds = 1./ds_parent + invds2 = ds_child/ds_parent + invds3 = 0.5/real(coeffraf) + ypos2 = ypos*invds + globind_parent_right=globind_parent_right*invds +! + if (.not.allocated(indparent)) then + allocate(indparent(nc*np2,3),coeffparent(nc*np2,3)) + else + if ( size(indparent,1) < nc*np2 ) then + allocate(coeffparent_tmp(size(indparent,1),size(indparent,2))) + allocate( indparent_tmp(size(indparent,1),size(indparent,2))) + coeffparent_tmp = coeffparent + indparent_tmp = indparent + deallocate(indparent,coeffparent) + allocate(indparent(nc*np2,3),coeffparent(nc*np2,3)) + coeffparent(1:size(coeffparent_tmp,1),1:size(coeffparent_tmp,2)) = coeffparent_tmp + indparent( 1:size(indparent_tmp, 1),1:size(indparent_tmp, 2)) = indparent_tmp + deallocate(indparent_tmp,coeffparent_tmp) + endif + endif +! + do i = 1,nc-1 +! + if (ypos2 > globind_parent_right) then + locind_parent_left = locind_parent_left + 1 + globind_parent_right = globind_parent_right + 1. + ypos2 = ypos*invds+(i-1)*invds2 + endif +! + diff = globind_parent_right - ypos2 + diff = invds3*nint(2*coeffraf*diff) + indparent(i,dir) = locind_parent_left + coeffparent(i,dir) = diff + ypos2 = ypos2 + invds2 +! + enddo +! + ypos = s_child + (nc-1)*ds_child + locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) + + if (locind_parent_left == np) then + indparent(nc,dir) = locind_parent_left-1 + coeffparent(nc,dir) = 0. + else + globind_parent_left = s_parent + (locind_parent_left - 1)*ds_parent + indparent(nc,dir) = locind_parent_left + diff = (globind_parent_left + ds_parent - ypos) * invds + diff = invds3*nint(2*coeffraf*diff) + coeffparent(nc,dir) = diff + endif + + do i=2, np2 + inc = i*nc + inc1 = (i-1)*nc + inc2 = (i-2)*nc +!CDIR ALTCODE + indparent(1+inc1:inc,dir) = indparent(1+inc2:inc1,dir)+np +!CDIR ALTCODE + coeffparent(1+inc1:inc,dir) =coeffparent(1:nc,dir) + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Linear1dPrecompute2d +!=================================================================================================== +! +!=================================================================================================== +! subroutine Linear1dAfterCompute +! +!> Carries out a linear 1D interpolation on a child grid (vector y) from its parent grid (vector x) +!! using precomputed coefficient and index. +!--------------------------------------------------------------------------------------------------- +subroutine Linear1dAfterCompute ( x, y, np, nc, dir ) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: np, nc + real, dimension(np), intent(in) :: x + real, dimension(nc), intent(out) :: y + integer, intent(in) :: dir +! + integer :: i +! +!CDIR ALTCODE +!CDIR NODEP + do i = 1,nc + y(i) = coeffparent(i,dir) * x(MAX(indparent(i,dir),1)) + & + (1.-coeffparent(i,dir)) * x(indparent(i,dir)+1) + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Linear1dAfterCompute +!=================================================================================================== +! +!=================================================================================================== +! subroutine Lagrange1d +! +!> Carries out a lagrange 1D interpolation on a child grid (vector y) from its parent grid +!! (vector x). +!--------------------------------------------------------------------------------------------------- +subroutine Lagrange1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child ) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: np, nc + real, dimension(np), intent(in) :: x + real, dimension(nc), intent(out) :: y + real, intent(in) :: s_parent, s_child + real, intent(in) :: ds_parent, ds_child +! + integer :: i, coeffraf, locind_parent_left + real :: ypos,globind_parent_left + real :: deltax, invdsparent + real :: t2,t3,t4,t5,t6,t7,t8 +! + if (np <= 2) then + call Agrif_basicinterp_linear1D(x,y,np,nc,s_parent,s_child,ds_parent,ds_child) + return + endif +! + coeffraf = nint(ds_parent/ds_child) +! + if (coeffraf == 1) then + locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent) + y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1) + return + endif +! + invdsparent = 1./ds_parent + ypos = s_child +! + do i = 1,nc +! + locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) + globind_parent_left = s_parent + (locind_parent_left - 1)*ds_parent + + deltax = invdsparent*(ypos-globind_parent_left) + deltax = nint(coeffraf*deltax)/real(coeffraf) + + ypos = ypos + ds_child + if (abs(deltax) <= 0.0001) then + y(i)=x(locind_parent_left) + cycle + endif +! + t2 = deltax - 2. + t3 = deltax - 1. + t4 = deltax + 1. + + t5 = -(1./6.)*deltax*t2*t3 + t6 = 0.5*t2*t3*t4 + t7 = -0.5*deltax*t2*t4 + t8 = (1./6.)*deltax*t3*t4 + + y(i) = t5*x(locind_parent_left-1) + t6*x(locind_parent_left) & + +t7*x(locind_parent_left+1) + t8*x(locind_parent_left+2) +! + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Lagrange1d +!=================================================================================================== +! +!=================================================================================================== +! subroutine Constant1d +! +!> Carries out a constant 1D interpolation on a child grid (vector y) from its parent grid (vector x). +!--------------------------------------------------------------------------------------------------- +subroutine Constant1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child ) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: np, nc + real, dimension(np), intent(in) :: x + real, dimension(nc), intent(out) :: y + real, intent(in) :: s_parent, s_child + real, intent(in) :: ds_parent, ds_child +! + integer :: i, coeffraf, locind_parent + real :: ypos +! + coeffraf = nint(ds_parent/ds_child) +! + if (coeffraf == 1) then + locind_parent = 1 + nint((s_child - s_parent)/ds_parent) + y(1:nc) = x(locind_parent:locind_parent+nc-1) + return + endif +! + ypos = s_child +! + do i = 1,nc +! + locind_parent = 1 + nint((ypos - s_parent)/ds_parent) + y(i) = x(locind_parent) + ypos = ypos + ds_child +! + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Constant1d +!=================================================================================================== +! +!=================================================================================================== +! subroutine Linear1dConserv +! +!> Carries out a conservative linear 1D interpolation on a child grid (vector y) from its parent +!! grid (vector x). +!--------------------------------------------------------------------------------------------------- +subroutine Linear1dConserv ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child ) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: np, nc + real, dimension(np), intent(in) :: x + real, dimension(nc), intent(out) :: y + real, intent(in) :: s_parent, s_child + real, intent(in) :: ds_parent, ds_child +! + real, dimension(:), allocatable :: ytemp + integer :: i,coeffraf,locind_parent_left,locind_parent_last + real :: ypos,xdiffmod,xpmin,xpmax,slope + integer :: i1,i2,ii + integer :: diffmod +! + coeffraf = nint(ds_parent/ds_child) +! + if (coeffraf == 1) then + locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent) + y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1) + return + endif +! + diffmod = 0 + if (mod(coeffraf,2) == 0) diffmod = 1 + + xdiffmod = real(diffmod)/2. + + allocate(ytemp(-2*coeffraf:nc+2*coeffraf)) +! + ypos = s_child +! + locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) + locind_parent_last = 1 + agrif_ceiling((ypos +(nc - 1) *ds_child - s_parent)/ds_parent) + + xpmin = s_parent + (locind_parent_left-1)*ds_parent + xpmax = s_parent + (locind_parent_last-1)*ds_parent + + i1 = 1+agrif_int((xpmin-s_child)/ds_child) + i2 = 1+agrif_int((xpmax-s_child)/ds_child) + + i = i1 + + if (locind_parent_left == 1) then + slope = (x(locind_parent_left+1)-x(locind_parent_left))/(coeffraf) + else + slope = (x(locind_parent_left+1)-x(locind_parent_left-1))/(2.*coeffraf) + endif + + do ii = i-coeffraf/2+diffmod,i+coeffraf/2 + ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope + enddo + + locind_parent_left = locind_parent_left + 1 + + do i = i1+coeffraf, i2-coeffraf,coeffraf + slope = (x(locind_parent_left+1)-x(locind_parent_left-1))/(2.*coeffraf) + do ii = i-coeffraf/2+diffmod,i+coeffraf/2 + ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope + enddo + locind_parent_left = locind_parent_left + 1 + enddo + + i = i2 + + if (locind_parent_left == np) then + slope = (x(locind_parent_left)-x(locind_parent_left-1))/(coeffraf) + else + slope = (x(locind_parent_left+1)-x(locind_parent_left-1))/(2.*coeffraf) + endif + + do ii = i-coeffraf/2+diffmod,nc + ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope + enddo +! + y(1:nc)=ytemp(1:nc) +! + deallocate(ytemp) +!--------------------------------------------------------------------------------------------------- +end subroutine Linear1dConserv +!=================================================================================================== +! +!=================================================================================================== +! subroutine Linear1dConservLim +! +!> Carries out a limited conservative linear 1D interpolation on a child grid (vector y) from +!! its parent grid (vector x). +!--------------------------------------------------------------------------------------------------- +subroutine Linear1dConservLim ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child ) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: np, nc + real, dimension(np), intent(in) :: x + real, dimension(nc), intent(out) :: y + real, intent(in) :: s_parent, s_child + real, intent(in) :: ds_parent, ds_child +! + real, dimension(:), allocatable :: ytemp + integer :: i,coeffraf,locind_parent_left,locind_parent_last + real :: ypos,xdiffmod,xpmin,xpmax,slope + integer :: i1,i2,ii + integer :: diffmod +! + coeffraf = nint(ds_parent/ds_child) +! + if (coeffraf == 1) then + locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent) + y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1) + return + endif +! + if (coeffraf /= 3) then + print *,'Linear1dConservLim not ready for refinement ratio = ', coeffraf + stop + endif +! + diffmod = 0 + if (mod(coeffraf,2) == 0) diffmod = 1 + + xdiffmod = real(diffmod)/2. + + allocate(ytemp(-2*coeffraf:nc+2*coeffraf)) +! + ypos = s_child +! + locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) + locind_parent_last = 1 + agrif_ceiling((ypos +(nc - 1) *ds_child - s_parent)/ds_parent) + + xpmin = s_parent + (locind_parent_left-1)*ds_parent + xpmax = s_parent + (locind_parent_last-1)*ds_parent + + i1 = 1+agrif_int((xpmin-s_child)/ds_child) + i2 = 1+agrif_int((xpmax-s_child)/ds_child) + + i = i1 + + if (locind_parent_left == 1) then + slope=0. + else + slope = Agrif_limiter_vanleer(x(locind_parent_left-1:locind_parent_left+1)) + slope = slope / coeffraf + endif + + do ii = i-coeffraf/2+diffmod,i+coeffraf/2 + ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope + enddo + + locind_parent_left = locind_parent_left + 1 + + do i = i1+coeffraf, i2-coeffraf,coeffraf + slope = Agrif_limiter_vanleer(x(locind_parent_left-1:locind_parent_left+1)) + slope = slope / coeffraf + do ii=i-coeffraf/2+diffmod,i+coeffraf/2 + ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope + enddo + locind_parent_left = locind_parent_left + 1 + enddo + + i = i2 + + if (locind_parent_left == np) then + slope=0. + else + slope = Agrif_limiter_vanleer(x(locind_parent_left-1:locind_parent_left+1)) + slope = slope / coeffraf + endif + + do ii=i-coeffraf/2+diffmod,nc + ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope + enddo +! + y(1:nc) = ytemp(1:nc) +! + deallocate(ytemp) +!--------------------------------------------------------------------------------------------------- +end subroutine Linear1dConservLim +!=================================================================================================== +! +!=================================================================================================== +! subroutine PPM1d +! +!> Carries out a 1D interpolation and apply monotonicity constraints using piecewise parabolic +!! method (PPM) on a child grid (vector y) from its parent grid (vector x). +!--------------------------------------------------------------------------------------------------- +subroutine PPM1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child ) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: np, nc + real, dimension(np), intent(in) :: x + real, dimension(nc), intent(out) :: y + real, intent(in) :: s_parent, s_child + real, intent(in) :: ds_parent, ds_child +! + integer :: i,coeffraf,locind_parent_left,locind_parent_last + integer :: iparent,ipos,pos,nmin,nmax + real :: ypos + integer :: i1,jj + real :: xpmin,a +! + real, dimension(np) :: xl,delta,a6,slope + integer :: diffmod + real :: invcoeffraf +! + coeffraf = nint(ds_parent/ds_child) +! + if (coeffraf == 1) then + locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent) +!CDIR ALTCODE +!CDIR SHORTLOOP + y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1) + return + endif +! + invcoeffraf = ds_child/ds_parent +! + if( .not. allocated(tabtest4) ) then + allocate(tabtest4(-2*coeffraf:nc+2*coeffraf)) + else + if (size(tabtest4) < nc+4*coeffraf+1) then + deallocate( tabtest4 ) + allocate(tabtest4(-2*coeffraf:nc+2*coeffraf)) + endif + endif +! + ypos = s_child +! + locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) + locind_parent_last = 1 + agrif_ceiling((ypos +(nc - 1)*ds_child - s_parent)/ds_parent) +! + xpmin = s_parent + (locind_parent_left-1)*ds_parent + i1 = 1+agrif_int((xpmin-s_child)/ds_child) +! +!CDIR NOVECTOR + do i=1,coeffraf + tabdiff2(i) = (real(i)-0.5)*invcoeffraf + enddo +! + a = invcoeffraf**2 + tabdiff3(1) = (1./3.)*a + a = 2.*a +!CDIR NOVECTOR + do i=2,coeffraf + tabdiff3(i) = tabdiff3(i-1)+(real(i)-1)*a + enddo +! + if ( locind_parent_last+2 <= np ) then + nmax = locind_parent_last+2 + else if ( locind_parent_last+1 <= np ) then + nmax = locind_parent_last+1 + else + nmax = locind_parent_last + endif +! + if (locind_parent_left-1 >= 1) then + nmin = locind_parent_left-1 + else + nmin = locind_parent_left + endif +! +!CDIR ALTCODE +!CDIR SHORTLOOP + do i = nmin,nmax + slope(i) = x(i) - x(i-1) + enddo +! +!CDIR ALTCODE +!CDIR SHORTLOOP + do i = nmin+1,nmax-1 + xl(i)= 0.5*(x(i-1)+x(i))-0.08333333333333*(slope(i+1)-slope(i-1)) + enddo +! +! apply parabolic monotonicity +!CDIR ALTCODE +!CDIR SHORTLOOP + do i = locind_parent_left,locind_parent_last + delta(i) = xl(i+1) - xl(i) + a6(i) = 6.*x(i)-3.*(xl(i) +xl(i+1)) + enddo +! + diffmod = 0 + if (mod(coeffraf,2) == 0) diffmod = 1 +! + ipos = i1 +! + do iparent = locind_parent_left,locind_parent_last + pos=1 +!CDIR ALTCODE +!CDIR SHORTLOOP + do jj = ipos-coeffraf/2+diffmod,ipos+coeffraf/2 +! + tabtest4(jj) = xl(iparent) + tabdiff2(pos) * (delta(iparent)+a6(iparent)) & + - tabdiff3(pos) * a6(iparent) + pos = pos+1 + enddo + ipos = ipos + coeffraf + enddo +! +!CDIR ALTCODE +!CDIR SHORTLOOP + y(1:nc) = tabtest4(1:nc) +!--------------------------------------------------------------------------------------------------- +end subroutine PPM1d +!=================================================================================================== +! +!=================================================================================================== +! subroutine PPM1dPrecompute2d +! +!> Computes 2D coefficients and index for a 1D interpolation using piecewise parabolic method +!--------------------------------------------------------------------------------------------------- +subroutine PPM1dPrecompute2d ( np2, np, nc, s_parent, s_child, ds_parent, ds_child, dir ) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: np2, np, nc + real, intent(in) :: s_parent, s_child + real, intent(in) :: ds_parent, ds_child + integer, intent(in) :: dir +! + integer, dimension(:,:), allocatable :: indparent_tmp + integer, dimension(:,:), allocatable :: indchild_tmp + integer :: i,coeffraf,locind_parent_left,locind_parent_last + integer :: iparent,ipos,pos + real :: ypos + integer :: i1,jj + real :: xpmin,a +! + integer :: diffmod + real :: invcoeffraf +! + coeffraf = nint(ds_parent/ds_child) +! + invcoeffraf = ds_child/ds_parent +! + if (.not.allocated(indparentppm)) then + allocate(indparentppm(np2*nc,3),indchildppm(np2*nc,3)) + else + if (size(indparentppm,1) < np2*nc) then + allocate( & + indparent_tmp(size(indparentppm,1),size(indparentppm,2)), & + indchild_tmp( size(indparentppm,1),size(indparentppm,2))) + indparent_tmp = indparentppm + indchild_tmp = indchildppm + deallocate(indparentppm,indchildppm) + allocate(indparentppm(np2*nc,3),indchildppm(np2*nc,3)) + indparentppm(1:size(indparent_tmp,1),1:size(indparent_tmp,2)) = indparent_tmp + indchildppm( 1:size(indparent_tmp,1),1:size(indparent_tmp,2)) = indchild_tmp + deallocate(indparent_tmp,indchild_tmp) + endif + endif + + if (.not.allocated(indparentppm_1d)) then + allocate(indparentppm_1d(-2*coeffraf:nc+2*coeffraf), & + indchildppm_1d( -2*coeffraf:nc+2*coeffraf)) + else + if (size(indparentppm_1d) < nc+4*coeffraf+1) then + deallocate(indparentppm_1d,indchildppm_1d) + allocate(indparentppm_1d(-2*coeffraf:nc+2*coeffraf),& + indchildppm_1d( -2*coeffraf:nc+2*coeffraf)) + endif + endif +! + ypos = s_child +! + locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) + locind_parent_last = 1 + agrif_ceiling((ypos +(nc - 1)*ds_child - s_parent)/ds_parent) +! + xpmin = s_parent + (locind_parent_left-1)*ds_parent + i1 = 1+agrif_int((xpmin-s_child)/ds_child) +! + do i = 1,coeffraf + tabdiff2(i)=(real(i)-0.5)*invcoeffraf + enddo +! + a = invcoeffraf**2 + tabdiff3(1) = (1./3.)*a + a = 2.*a +!CDIR ALTCODE + do i = 2,coeffraf + tabdiff3(i) = tabdiff3(i-1)+(real(i)-1)*a + enddo + +!CDIR ALTCODE + do i = 1,coeffraf + tabppm(1,i,dir) = 0.08333333333333*(-1.+4*tabdiff2(i)-3*tabdiff3(i)) + tabppm(2,i,dir) = 0.08333333333333*(7.-26.*tabdiff2(i)+18.*tabdiff3(i)) + tabppm(3,i,dir) = 0.08333333333333*(7.+30*tabdiff2(i)-30*tabdiff3(i)) + tabppm(4,i,dir) = 0.08333333333333*(-1.-10.*tabdiff2(i)+18.*tabdiff3(i)) + tabppm(5,i,dir) = 0.08333333333333*(2*tabdiff2(i)-3*tabdiff3(i)) + enddo +! + diffmod = 0 + if (mod(coeffraf,2) == 0) diffmod = 1 +! + ipos = i1 +! + do iparent = locind_parent_left,locind_parent_last + pos=1 +!CDIR ALTCODE + do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2 + indparentppm_1d(jj) = iparent-2 + indchildppm_1d(jj) = pos + pos = pos+1 + enddo + ipos = ipos + coeffraf + enddo +! + do i = 1,np2 + indparentppm(1+(i-1)*nc:i*nc,dir) = indparentppm_1d(1:nc) + (i-1)*np + indchildppm (1+(i-1)*nc:i*nc,dir) = indchildppm_1d (1:nc) + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine PPM1dPrecompute2d +!=================================================================================================== +! +!=================================================================================================== +!subroutine PPM1dPrecompute(np,nc,& +! s_parent,s_child,ds_parent,ds_child) +!! +!!CC Description: +!!CC subroutine to compute coefficient and index for a 1D interpolation +!!CC using piecewise parabolic method +!!C Method: +!! +!! Declarations: +!! +! Implicit none +!! +!! Arguments +! Integer :: np,nc +!! Real, Dimension(:),Allocatable :: ytemp +! Real :: s_parent,s_child,ds_parent,ds_child +!! +!! Local scalars +! Integer :: i,coeffraf,locind_parent_left,locind_parent_last +! Integer :: iparent,ipos,pos,nmin,nmax +! Real :: ypos +! integer :: i1,jj +! Real :: xpmin,a +!! +! Real :: xrmin,xrmax,am3,s2,s1 +! Real, Dimension(np) :: xl,delta,a6,slope +!! Real, Dimension(:),Allocatable :: diff,diff2,diff3 +! INTEGER :: diffmod +! REAL :: invcoeffraf +!! +! coeffraf = nint(ds_parent/ds_child) +!! +! If (coeffraf == 1) Then +! return +! End If +! invcoeffraf = ds_child/ds_parent +!! +! +! if (.not.allocated(indparentppm)) then +! allocate(indparentppm(-2*coeffraf:nc+2*coeffraf,1),& +! indchildppm(-2*coeffraf:nc+2*coeffraf,1)) +! else +! if (size(indparentppm,1) 0) then +! etap = etap+1 +! else if (ak(k,i) < 0) then +! etan = etan + 1 +! endif +! enddo +! +! do k=0,1 +! if (ak(k,i) == 0) then +! Ck(k,i) = 1. +! else if (ak(k,i) > 0) then +! Ck(k,i) = 1./(etap * ak(k,i)) +! else +! Ck(k,i) = -1./(etan * ak(k,i)) +! endif +! enddo +! enddo +! +! +! a = 0. +! b = invcoeffraf +! Do i=1,coeffraf +! diff2(i) = 0.5*(b*b - a*a) +! diff3(i) = (1./3.)*(b*b*b - a*a*a) +! a = a + invcoeffraf +! b = b + invcoeffraf +! End do +! +! if( locind_parent_last+2 <= np ) then +! nmax = locind_parent_last+2 +! elseif( locind_parent_last+1 <= np ) then +! nmax = locind_parent_last+1 +! else +! nmax = locind_parent_last +! endif +! +! if(locind_parent_left-2 >= 1) then +! nmin = locind_parent_left-2 +! elseif(locind_parent_left-1 >= 1) then +! nmin = locind_parent_left-1 +! else +! nmin = locind_parent_left +! endif +! +! Do i = nmin+1,nmax +! slope(i) = (x(i) - x(i-1)) +! Enddo +! DO i=nmin+2,nmax +! smooth(i) = 0.5*(slope(i)**2+slope(i-1)**2)& +! +(slope(i)-slope(i-1))**2 +! enddo +! +! diffmod = 0 +! IF (mod(coeffraf,2) == 0) diffmod = 1 +! +! ipos = i1 +! +! Do iparent = locind_parent_left,locind_parent_last +! pos=1 +! +! delta0=1./(epsilon+smooth(iparent ))**3 +! delta1=1./(epsilon+smooth(iparent+1))**3 +! delta2=1./(epsilon+smooth(iparent+2))**3 +! +! Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2 +! +! pos = pos+1 +! End do +! ipos = ipos + coeffraf +! +! End do +! +! +! y(1:nc)=ytemp(1:nc) +! deallocate(ytemp) +! deallocate(diff, diff2, diff3) +! +! deallocate(ak,ck) +! +! Return +! End subroutine weno1dnew +!=================================================================================================== +! +!=================================================================================================== +! subroutine WENO1d +! +!> Carries out a a 1D interpolation using WENO method on a child grid (vector y) from its parent +!! grid (vector x). +!--------------------------------------------------------------------------------------------------- +subroutine WENO1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child ) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: np, nc + real, dimension(np), intent(in) :: x + real, dimension(nc), intent(out) :: y + real, intent(in) :: s_parent, s_child + real, intent(in) :: ds_parent, ds_child +! + real, dimension(:), allocatable :: ytemp + integer :: i,coeffraf,locind_parent_left,locind_parent_last + integer :: iparent,ipos,pos,nmin,nmax + real :: ypos + integer :: i1,jj + real :: xpmin +! + real, dimension(np) :: slope + real, dimension(:), allocatable :: diff + integer :: diffmod + real :: invcoeffraf + real :: delta0, delta1, sumdelta + real, parameter :: epsilon = 1.d-8 +! + coeffraf = nint(ds_parent/ds_child) +! + if (coeffraf == 1) then + locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent) + y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1) + return + endif +! + invcoeffraf = ds_child/ds_parent +! + allocate(ytemp(-2*coeffraf:nc+2*coeffraf)) + ypos = s_child +! + locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) + locind_parent_last = 1 + agrif_ceiling((ypos +(nc - 1) *ds_child - s_parent)/ds_parent) +! + xpmin = s_parent + (locind_parent_left-1)*ds_parent + i1 = 1+agrif_int((xpmin-s_child)/ds_child) +! + allocate(diff(coeffraf)) + diff(1) = 0.5*invcoeffraf + do i = 2,coeffraf + diff(i) = diff(i-1)+invcoeffraf + enddo +! + if ( locind_parent_last+2 <= np ) then + nmax = locind_parent_last+2 + else if ( locind_parent_last+1 <= np ) then + nmax = locind_parent_last+1 + else + nmax = locind_parent_last + endif +! + if(locind_parent_left-1 >= 1) then + nmin = locind_parent_left-1 + else + nmin = locind_parent_left + endif +! + do i = nmin+1,nmax + slope(i) = x(i) - x(i-1) + enddo +! + diffmod = 0 + if (mod(coeffraf,2) == 0) diffmod = 1 +! + ipos = i1 +! + do iparent = locind_parent_left,locind_parent_last + pos=1 + delta0 = 1./(epsilon+slope(iparent )**2)**2 + delta1 = 1./(epsilon+slope(iparent+1)**2)**2 + sumdelta = 1./(delta0+delta1) + do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2 + ytemp(jj) = x(iparent)+(diff(pos)-0.5)*( delta0*slope(iparent) + & + delta1*slope(iparent+1))*sumdelta + pos = pos+1 + enddo + ipos = ipos + coeffraf + enddo +! + y(1:nc) = ytemp(1:nc) + deallocate(ytemp) + deallocate(diff) +!--------------------------------------------------------------------------------------------------- +end subroutine WENO1d +!=================================================================================================== +! +!=================================================================================================== +! subroutine ENO1d +! +!> Carries out a 1D interpolation using piecewise polynomial ENO reconstruction technique +!! on a child grid (vector y) from its parent grid (vector x). +!! \see ---- p 163-164 Computational gasdynamics ---- +!--------------------------------------------------------------------------------------------------- +subroutine ENO1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child ) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: np, nc + real, dimension(np), intent(in) :: x + real, dimension(nc), intent(out) :: y + real, intent(in) :: s_parent, s_child + real, intent(in) :: ds_parent, ds_child +! + integer :: i,coeffraf,locind_parent_left,locind_parent_last + integer :: ipos, pos + real :: ypos,xi + integer :: i1,jj + real :: xpmin +! + real, dimension(:), allocatable :: ytemp + real, dimension(:,:), allocatable :: xbar + real, dimension(1:np+1) :: xhalf + real, dimension(3,np) :: dd, c + integer :: diffmod, left +! + coeffraf = nint(ds_parent/ds_child) +! + if (coeffraf == 1) then + locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent) + y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1) + return + end if + + diffmod = 0 + if (mod(coeffraf,2) == 0) diffmod = 1 +! + allocate(ytemp(-2*coeffraf:nc+2*coeffraf)) + ypos = s_child +! + locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) + locind_parent_last = 1 + agrif_ceiling((ypos +(nc - 1) *ds_child - s_parent)/ds_parent) +! + xpmin = s_parent + (locind_parent_left-1)*ds_parent + i1 = 1+agrif_int((xpmin-s_child)/ds_child) +! + do i = 1,np+1 + xhalf(i) = i - 0.5 + enddo +! +! Compute divided differences +! + dd(1,1:np) = x(1:np) + dd(2,1:np-1) = 0.5*( dd(1,2:np) - dd(1,1:np-1) ) + dd(3,1:np-2) = (1./3.)*( dd(2,2:np-1) - dd(2,1:np-2) ) +! + allocate( xbar( coeffraf,2 ) ) + xi = 0.5 + do i = 1,coeffraf + xbar(i,1) = (i-1)*ds_child/ds_parent - xi + xbar(i,2) = i *ds_child/ds_parent - xi + enddo +! + ipos = i1 +! + do i = locind_parent_left,locind_parent_last + left = i + do jj = 2,3 + if(abs(dd(jj,left)) > abs(dd(jj,left-1))) left = left-1 + enddo +! +! convert to Taylor series form + call taylor(i,xhalf(left:left+2),dd(1:3,left),c(1:3,i)) + enddo +! +! Evaluate the reconstruction on each cell +! + do i = locind_parent_left,locind_parent_last +! + pos = 1 +! + do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2 + ytemp(jj) = ( c(1,i)*(xbar(pos,2)-xbar(pos,1)) & + + c(2,i)*(xbar(pos,2)*xbar(pos,2) - & + xbar(pos,1)*xbar(pos,1)) & + + c(3,i)*(xbar(pos,2)*xbar(pos,2)*xbar(pos,2) - & + xbar(pos,1)*xbar(pos,1)*xbar(pos,1)) & + ) * coeffraf + pos = pos+1 + enddo + ipos = ipos + coeffraf +! + enddo +! + y(1:nc) = ytemp(1:nc) + deallocate(ytemp,xbar) +!--------------------------------------------------------------------------------------------------- +end subroutine ENO1d +!=================================================================================================== +! +! ************************************************************************** +!CC Subroutine ppm1d_lim +! ************************************************************************** +! + Subroutine ppm1d_lim(x,y,np,nc,s_parent,s_child,ds_parent,ds_child) +! +!CC Description: +!CC Subroutine to do a 1D interpolation and apply monotonicity constraints +!CC using piecewise parabolic method +!CC on a child grid (vector y) from its parent grid (vector x). +!C Method: +! +! Declarations: +! + Implicit none +! +! Arguments + Integer :: np,nc + Real, Dimension(np) :: x + Real, Dimension(nc) :: y + Real, Dimension(:),Allocatable :: ytemp + Real :: s_parent,s_child,ds_parent,ds_child +! +! Local scalars + Integer :: i,coeffraf,locind_parent_left,locind_parent_last + Integer :: iparent,ipos,pos,nmin,nmax + Real :: ypos + integer :: i1,jj + Real :: xpmin,cavg,a,b +! + Real :: xrmin,xrmax,am3,s2,s1 + Real, Dimension(np) :: dela,xr,xl,delta,a6,slope,slope2 + Real, Dimension(:),Allocatable :: diff,diff2,diff3 + INTEGER :: diffmod +! + coeffraf = nint(ds_parent/ds_child) +! + If (coeffraf == 1) Then + locind_parent_left = 1 + nint((s_child - s_parent)/ds_parent) + y(1:nc) = x(locind_parent_left:locind_parent_left+nc-1) + return + End If +! + Allocate(ytemp(-2*coeffraf:nc+2*coeffraf)) + ypos = s_child +! + locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent) + locind_parent_last = 1 + & + agrif_ceiling((ypos +(nc - 1) & + *ds_child - s_parent)/ds_parent) +! + xpmin = s_parent + (locind_parent_left-1)*ds_parent + i1 = 1+agrif_int((xpmin-s_child)/ds_child) +! + Allocate( diff(coeffraf),diff2(coeffraf),diff3(coeffraf) ) +! + diff(:) = ds_child/ds_parent +! + Do i=1,coeffraf + a = real(i-1)*ds_child/ds_parent + b = real(i)*ds_child/ds_parent + diff2(i) = 0.5*(b*b - a*a) + diff3(i) = (1./3.)*(b*b*b - a*a*a) + End do +! + if( locind_parent_last+2 <= np ) then + nmax = locind_parent_last+2 + else if( locind_parent_last+1 <= np ) then + nmax = locind_parent_last+1 + else + nmax = locind_parent_last + endif +! + if(locind_parent_left-1 >= 1) then + nmin = locind_parent_left-1 + else + nmin = locind_parent_left + endif +! + Do i = nmin,nmax + slope(i) = x(i) - x(i-1) + slope2(i) = 2.*abs(slope(i)) + Enddo +! + Do i = nmin,nmax-1 + dela(i) = 0.5 * ( slope(i) + slope(i+1) ) +! Van Leer slope limiter + dela(i) = min( abs(dela(i)),slope2(i), & + slope2(i+1) )*sign(1.,dela(i)) + IF( slope(i)*slope(i+1) <= 0. ) dela(i) = 0. + Enddo +! + Do i = nmin,nmax-2 + xr(i) = x(i) + (1./2.)*slope(i+1) + (-1./6.)*dela(i+1) & + + ( 1./6. )*dela(i) + Enddo +! + Do i = nmin,nmax-2 + xrmin = min(x(i),x(i+1)) + xrmax = max(x(i),x(i+1)) + xr(i) = min(xr(i),xrmax) + xr(i) = max(xr(i),xrmin) + xl(i+1) = xr(i) + Enddo +! apply parabolic monotonicity + Do i = locind_parent_left,locind_parent_last + If( ( (xr(i)-x(i))* (x(i)-xl(i)) ) .le. 0. ) then + xl(i) = x(i) + xr(i) = x(i) + Endif + delta(i) = xr(i) - xl(i) + am3 = 3. * x(i) + s1 = am3 - 2. * xr(i) + s2 = am3 - 2. * xl(i) + IF( delta(i) * (xl(i) - s1) .le. 0. ) xl(i) = s1 + IF( delta(i) * (s2 - xr(i)) .le. 0. ) xr(i) = s2 + delta(i) = xr(i) - xl(i) + a6(i) = 6.*x(i)-3.*(xl(i) +xr(i)) +! + End do +! + diffmod = 0 + IF (mod(coeffraf,2) == 0) diffmod = 1 +! + ipos = i1 +! + Do iparent = locind_parent_left,locind_parent_last + pos=1 + cavg = 0. + Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2 +! + ytemp(jj) = (diff(pos)*xl(iparent) & + + diff2(pos) & + * (delta(iparent)+a6(iparent)) & + - diff3(pos)*a6(iparent))*coeffraf + + cavg = cavg + ytemp(jj) + pos = pos+1 + End do + ipos = ipos + coeffraf +! + End do +! +! + y(1:nc)=ytemp(1:nc) + deallocate(ytemp) + deallocate(diff, diff2, diff3) + Return + End Subroutine ppm1d_lim +!=================================================================================================== +! subroutine taylor +!--------------------------------------------------------------------------------------------------- +subroutine taylor ( ind, xhalf, dd, c ) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: ind + real, dimension(3), intent(in) :: xhalf + real, dimension(3), intent(in) :: dd + real, dimension(3), intent(out) :: c +! + real, dimension(0:3,0:3) :: d + integer :: i, j +! + d(0,0:3) = 1.0 + do i = 1,3 + d(i,0) = (ind-xhalf(i))*d(i-1,0) + enddo +! + do i = 1,3 + do j = 1,3-i + d(i,j) = d(i,j-1) + (ind-xhalf(i+j))*d(i-1,j) + enddo + enddo +! + do j = 1,3 + c(j) = 0. + do i=0,3-j + c(j) = c(j) + d(i,j)*dd(i+j) + enddo + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine taylor +!=================================================================================================== +! +!=================================================================================================== +! function Agrif_limiter_vanleer +!--------------------------------------------------------------------------------------------------- +real function Agrif_limiter_vanleer ( tab ) result(res) +!--------------------------------------------------------------------------------------------------- + real, dimension(3), intent(in) :: tab +! + real :: p1, p2, p3 + + p1 = (tab(3)-tab(1))/2. + p2 = 2.*(tab(2)-tab(1)) + p3 = 2.*(tab(3)-tab(2)) + + if ((p1>0.).AND.(p2>0.).AND.(p3>0)) then + res = minval((/p1,p2,p3/)) + elseif ((p1<0.).AND.(p2<0.).AND.(p3<0)) then + res = maxval((/p1,p2,p3/)) + else + res=0. + endif +!--------------------------------------------------------------------------------------------------- +end function Agrif_limiter_vanleer +!=================================================================================================== +! +end module Agrif_InterpBasic diff --git a/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modlinktomodel.F90 b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modlinktomodel.F90 new file mode 100644 index 00000000..ef8c07a2 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modlinktomodel.F90 @@ -0,0 +1,173 @@ +! AGRIF (Adaptive Grid Refinement In Fortran) +! +! Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr) +! Christophe Vouland (Christophe.Vouland@imag.fr) +! +! This program is free software; you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation; either version 2 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program; if not, write to the Free Software +! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +! +! +!> Module Agrif_Link +!> +!> This module is used to link AGRIF files to the model. +! +module Agrif_Link +! + interface +! + subroutine Agrif_clustering_def ( ) +! + end subroutine Agrif_clustering_def +! + subroutine Agrif_Set_numberofcells ( Agrif_Gr ) + use Agrif_Grids, only : Agrif_Grid + type(Agrif_Grid), pointer :: Agrif_Gr !< Pointer on the current grid + end subroutine Agrif_Set_numberofcells +! + subroutine Agrif_Get_numberofcells ( Agrif_Gr ) + use Agrif_Grids, only : Agrif_Grid + type(Agrif_Grid), pointer :: Agrif_Gr !< Pointer on the current grid + end subroutine Agrif_Get_numberofcells +! + end interface +! + abstract interface +! + subroutine alloc_proc ( Agrif_Gr ) + use Agrif_Grids, only : Agrif_Grid + type(Agrif_Grid), pointer :: Agrif_Gr !< Pointer on the current grid + end subroutine alloc_proc +! + subroutine typedef_proc ( ) + implicit none + end subroutine typedef_proc +! + end interface + + procedure(alloc_proc) :: Agrif_Allocationcalls + procedure(typedef_proc) :: Agrif_probdim_modtype_def +! +end module Agrif_Link +! +!=================================================================================================== +! function Agrif_parent +! modify by conv. To use : un_parent = Agrif_Parent(un) +!=================================================================================================== +! function Agrif_Get_Coarse_Grid +! modify by conv. To use : un_Mygrid = Agrif_Get_Coarse_grid(un) +!=================================================================================================== +! function Agrif_Rhox +! modify by conv. To use : var = Agrif_Rhox() +! REAL(Agrif_Curgrid % spaceref(1)) +!=================================================================================================== +! function Agrif_Parent_Rhox +! modify by conv. To use : var = Agrif_Parent_Rhox() +! REAL(Agrif_Curgrid % parent % spaceref(1)) +!=================================================================================================== +! function Agrif_Irhox +! modify by conv. To use : var = Agrif_Parent_IRhox() +! Agrif_Curgrid % spaceref(1) +!=================================================================================================== +! function Agrif_Rhoy +! modify by conv. To use : var = Agrif_Rhoy() +! REAL(Agrif_Curgrid % spaceref(2)) +!=================================================================================================== +! function Agrif_Parent_Rhoy +! modify by conv. To use : var = Agrif_Parent_Rhoy() +! REAL(Agrif_Curgrid % parent % spaceref(2)) +!=================================================================================================== +! function Agrif_Irhoy +! modify by conv. To use : var = Agrif_Parent_IRhoy() +! Agrif_Curgrid % spaceref(2) +!=================================================================================================== + + +!=================================================================================================== +! function Agrif_Rhoz +! modify by conv. To use : var = Agrif_Rhoz() +! REAL(Agrif_Curgrid % spaceref(3)) +!=================================================================================================== +! function Agrif_Parent_Rhoz +! modify by conv. To use : var = Agrif_Parent_Rhoz() +! REAL(Agrif_Curgrid % parent % spaceref(3)) +!=================================================================================================== +! function Agrif_Irhoz +! modify by conv. To use : var = Agrif_Parent_IRhoz() +! Agrif_Curgrid % spaceref(3) + +!=================================================================================================== +! function Agrif_NearCommonBorderX +! modify by conv. To use : var = Agrif_NearCommonBorderX() +! Agrif_Curgrid % NearRootBorder(1) +!=================================================================================================== +! function Agrif_NearCommonBorderY +! modify by conv. To use : var = Agrif_NearCommonBorderY() +! Agrif_Curgrid % NearRootBorder(2) +!=================================================================================================== +! function Agrif_NearCommonBorderZ +! modify by conv. To use : var = Agrif_NearCommonBorderZ() +! Agrif_Curgrid % NearRootBorder(3) +!=================================================================================================== +! function Agrif_DistantCommonBorderX +! modify by conv. To use : var = Agrif_DistantCommonBorderX() +! Agrif_Curgrid % DistantRootBorder(1) +!=================================================================================================== +! function Agrif_DistantCommonBorderY +! modify by conv. To use : var = Agrif_DistantCommonBorderY() +! Agrif_Curgrid % DistantRootBorder(2) +!=================================================================================================== +! function Agrif_DistantCommonBorderZ +! modify by conv. To use : var = Agrif_DistantCommonBorderZ() +! Agrif_Curgrid % DistantRootBorder(3) +!=================================================================================================== +! function Agrif_Nb_Step +! modify by conv. To use : var = Agrif_Nb_Step() +! Agrif_Curgrid % ngridstep +!=================================================================================================== +! function Agrif_Nb_Fine_Grids +! modify by conv. To use : var = Agrif_Nb_Fine_Grids() +! Agrif_nbfixedgrids +!=================================================================================================== +! function Agrif_Ix +! modify by conv. To use : var = Agrif_Ix() +! Agrif_Curgrid % ix(1) +!=================================================================================================== +! function Agrif_Parent_Ix +! modify by conv. To use : var = Agrif_Parent_Ix() +! Agrif_Curgrid % parent % ix(1) +!=================================================================================================== +! function Agrif_Iy +! modify by conv. To use : var = Agrif_Iy() +! Agrif_Curgrid % ix(2) +!=================================================================================================== +! function Agrif_Parent_Iy +! modify by conv. To use : var = Agrif_Parent_Iy() +! Agrif_Curgrid % parent % ix(2) +!=================================================================================================== +! function Agrif_Iz +! modify by conv. To use : var = Agrif_Iz() +! Agrif_Curgrid % ix(3) +!=================================================================================================== +! function Agrif_Parent_Iz +! modify by conv. To use : var = Agrif_Parent_Iz() +! Agrif_Curgrid % parent % ix(3) +!=================================================================================================== +! function Agrif_Get_grid_id +! modify by conv. To use : var = Agrif_Get_grid_id() +! Agrif_Curgrid % grid_id +!=================================================================================================== +! function Agrif_Get_parent_id +! modify by conv. To use : var = Agrif_Get_parent_id() +! Agrif_Curgrid % parent % grid_id +!=================================================================================================== diff --git a/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modmask.F90 b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modmask.F90 new file mode 100644 index 00000000..96fe4755 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modmask.F90 @@ -0,0 +1,586 @@ +! +! $Id: modmask.F 779 2007-12-22 17:04:17Z rblod $ +! +! AGRIF (Adaptive Grid Refinement In Fortran) +! +! Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr) +! Christophe Vouland (Christophe.Vouland@imag.fr) +! +! This program is free software; you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation; either version 2 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program; if not, write to the Free Software +! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +! +! +!> Module Agrif_Mask. +!> +!> Module for masks. +! +module Agrif_Mask +! + use Agrif_Types +! + implicit none +! +contains +! +!=================================================================================================== +! subroutine Agrif_CheckMasknD +! +!> Called in the procedure #Agrif_InterpnD to recalculate the value of the parent grid variable +!! when this one is equal to Agrif_SpecialValue. +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_CheckMasknD ( tempP, parent, pbtab, petab, ppbtab, ppetab, noraftab, nbdim ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Variable), pointer :: tempP !< Part of the parent grid used for the interpolation of the child grid + type(Agrif_Variable), pointer :: parent !< The parent grid + integer, dimension(nbdim) :: pbtab !< limits of the parent grid used + integer, dimension(nbdim) :: petab !< interpolation of the child grid + integer, dimension(nbdim) :: ppbtab, ppetab + logical, dimension(nbdim) :: noraftab + integer :: nbdim +! + integer :: i0,j0,k0,l0,m0,n0 +! + select case (nbdim) + case (1) + do i0 = pbtab(1),petab(1) + if (tempP%array1(i0) == Agrif_SpecialValue) then + call CalculNewValTempP((/i0/),tempP,parent,ppbtab,ppetab,noraftab,nbdim) + endif + enddo + case (2) + do j0 = pbtab(2),petab(2) + do i0 = pbtab(1),petab(1) + if (tempP%array2(i0,j0) == Agrif_SpecialValue) then + call CalculNewValTempP((/i0,j0/),tempP,parent,ppbtab,ppetab, noraftab,nbdim) + endif + enddo + enddo + case (3) + do k0 = pbtab(3),petab(3) + do j0 = pbtab(2),petab(2) + do i0 = pbtab(1),petab(1) + if (tempP%array3(i0,j0,k0) == Agrif_SpecialValue) then +!------CDIR NEXPAND + call CalculNewValTempP3D((/i0,j0,k0/), & + tempP%array3(ppbtab(1),ppbtab(2),ppbtab(3)), & + parent%array3(ppbtab(1),ppbtab(2),ppbtab(3)), & + ppbtab,ppetab,noraftab,MaxSearch,Agrif_SpecialValue) + +! Call CalculNewValTempP((/i0,j0,k0/), +! & tempP,parent, +! & ppbtab,ppetab, +! & noraftab,nbdim) + + endif + enddo + enddo + enddo + case (4) + do l0 = pbtab(4),petab(4) + do k0 = pbtab(3),petab(3) + do j0 = pbtab(2),petab(2) + do i0 = pbtab(1),petab(1) + if (tempP%array4(i0,j0,k0,l0) == Agrif_SpecialValue) then + call CalculNewValTempP4D((/i0,j0,k0,l0/), & + tempP%array4(ppbtab(1),ppbtab(2),ppbtab(3),ppbtab(4)), & + parent%array4(ppbtab(1),ppbtab(2),ppbtab(3),ppbtab(4)), & + ppbtab,ppetab,noraftab,MaxSearch,Agrif_SpecialValue) + endif + enddo + enddo + enddo + enddo + case (5) + do m0 = pbtab(5),petab(5) + do l0 = pbtab(4),petab(4) + do k0 = pbtab(3),petab(3) + do j0 = pbtab(2),petab(2) + do i0 = pbtab(1),petab(1) + if (tempP%array5(i0,j0,k0,l0,m0) == Agrif_SpecialValue) then + call CalculNewValTempP((/i0,j0,k0,l0,m0/), & + tempP,parent,ppbtab,ppetab,noraftab,nbdim) + endif + enddo + enddo + enddo + enddo + enddo + case (6) + do n0 = pbtab(6),petab(6) + do m0 = pbtab(5),petab(5) + do l0 = pbtab(4),petab(4) + do k0 = pbtab(3),petab(3) + do j0 = pbtab(2),petab(2) + do i0 = pbtab(1),petab(1) + if (tempP%array6(i0,j0,k0,l0,m0,n0) == Agrif_SpecialValue) then + call CalculNewValTempP((/i0,j0,k0,l0,m0,n0/), & + tempP,parent,ppbtab,ppetab,noraftab,nbdim) + endif + enddo + enddo + enddo + enddo + enddo + enddo + end select +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_CheckMasknD +!=================================================================================================== +! +!=================================================================================================== +! subroutine CalculNewValTempP +! +!> Called in the procedure #Agrif_InterpnD to recalculate the value of the parent grid variable +!! when this one is equal to Agrif_SpecialValue. +!--------------------------------------------------------------------------------------------------- +subroutine CalculNewValTempP ( indic, tempP, parent, ppbtab, ppetab, noraftab, nbdim ) +!--------------------------------------------------------------------------------------------------- + integer, dimension(nbdim) :: indic + type(Agrif_Variable), pointer :: tempP !< Part of the parent grid used for the interpolation of the child grid + type(Agrif_Variable), pointer :: parent !< The parent grid + integer, dimension(nbdim) :: ppbtab, ppetab + logical, dimension(nbdim) :: noraftab + integer :: nbdim +! + integer :: i,ii,iii,jj,kk,ll,mm,nn + integer, dimension(nbdim) :: imin,imax,idecal + integer :: nbvals + real :: res + real :: valparent + integer :: ValMax + logical :: firsttest +! + ValMax = 1 + do iii = 1,nbdim + if (.NOT.noraftab(iii)) then + ValMax = max(ValMax,ppetab(iii)-indic(iii)) + ValMax = max(ValMax,indic(iii)-ppbtab(iii)) + endif + enddo +! + Valmax = min(Valmax,MaxSearch) +! +!CDIR NOVECTOR + imin = indic +!CDIR NOVECTOR + imax = indic +! + i = 1 + firsttest = .TRUE. +! + do while (i <= ValMax) +! + if ( (i == 1).AND.(firsttest) ) i = Valmax +! + do iii = 1,nbdim + if (.NOT.noraftab(iii)) then + imin(iii) = max(indic(iii) - i,ppbtab(iii)) + imax(iii) = min(indic(iii) + i,ppetab(iii)) + if (firsttest) then + if (indic(iii) > ppbtab(iii)) then +!CDIR NOVECTOR + idecal = indic + idecal(iii) = idecal(iii)-1 + SELECT CASE(nbdim) + CASE (1) + if (tempP%array1(idecal(1) & + ) == Agrif_SpecialValue) imin(iii) = imax(iii) + CASE (2) + if (tempP%array2(idecal(1), idecal(2) & + ) == Agrif_SpecialValue) imin(iii) = imax(iii) + CASE (3) + if (tempP%array3(idecal(1), & + idecal(2), idecal(3) & + ) == Agrif_SpecialValue) imin(iii) = imax(iii) + CASE (4) + if (tempP%array4(idecal(1), idecal(2), & + idecal(3), idecal(4) & + ) == Agrif_SpecialValue) imin(iii) = imax(iii) + CASE (5) + if (tempP%array5(idecal(1), idecal(2), & + idecal(3), idecal(4), & + idecal(5) & + ) == Agrif_SpecialValue) imin(iii) = imax(iii) + CASE (6) + if (tempP%array6(idecal(1), idecal(2), & + idecal(3), idecal(4), & + idecal(5), idecal(6) & + ) == Agrif_SpecialValue) imin(iii) = imax(iii) + END SELECT + endif + endif + endif + enddo +! + Res = 0. + Nbvals = 0 +! + SELECT CASE(nbdim) + CASE (1) +!CDIR ALTCODE +!CDIR SHORTLOOP + do ii = imin(1),imax(1) + ValParent = parent%array1(ii) + if ( ValParent /= Agrif_SpecialValue) then + Res = Res + ValParent + Nbvals = Nbvals + 1 + endif + enddo +! + CASE (2) + do jj = imin(2),imax(2) +!CDIR ALTCODE +!CDIR SHORTLOOP + do ii = imin(1),imax(1) + ValParent = parent%array2(ii,jj) + if ( ValParent /= Agrif_SpecialValue) then + Res = Res + ValParent + Nbvals = Nbvals + 1 + endif + enddo + enddo + + CASE (3) + do kk = imin(3),imax(3) + do jj = imin(2),imax(2) +!CDIR ALTCODE +!CDIR SHORTLOOP + do ii = imin(1),imax(1) + ValParent = parent%array3(ii,jj,kk) + if ( ValParent /= Agrif_SpecialValue) then + Res = Res + ValParent + Nbvals = Nbvals + 1 + endif + enddo + enddo + enddo + + CASE (4) + do ll = imin(4),imax(4) + do kk = imin(3),imax(3) + do jj = imin(2),imax(2) +!CDIR ALTCODE +!CDIR SHORTLOOP + do ii = imin(1),imax(1) + ValParent = parent%array4(ii,jj,kk,ll) + if ( ValParent /= Agrif_SpecialValue) then + Res = Res + ValParent + Nbvals = Nbvals + 1 + endif + enddo + enddo + enddo + enddo + + CASE (5) + do mm = imin(5),imax(5) + do ll = imin(4),imax(4) + do kk = imin(3),imax(3) + do jj = imin(2),imax(2) +!CDIR ALTCODE +!CDIR SHORTLOOP + do ii = imin(1),imax(1) + ValParent = parent%array5(ii,jj,kk,ll,mm) + if ( ValParent /= Agrif_SpecialValue) then + Res = Res + ValParent + Nbvals = Nbvals + 1 + endif + enddo + enddo + enddo + enddo + enddo + + CASE (6) + do nn = imin(6),imax(6) + do mm = imin(5),imax(5) + do ll = imin(4),imax(4) + do kk = imin(3),imax(3) + do jj = imin(2),imax(2) +!CDIR ALTCODE +!CDIR SHORTLOOP + do ii = imin(1),imax(1) + ValParent = parent%array6(ii,jj,kk,ll,mm,nn) + if ( ValParent /= Agrif_SpecialValue) then + Res = Res + ValParent + Nbvals = Nbvals + 1 + endif + enddo + enddo + enddo + enddo + enddo + enddo + + END SELECT +! + if (Nbvals > 0) then + if (firsttest) then + firsttest = .FALSE. + i=1 + cycle + endif + SELECT CASE(nbdim) + CASE (1) + tempP%array1(indic(1)) = Res/Nbvals + CASE (2) + tempP%array2(indic(1), indic(2)) = Res/Nbvals + CASE (3) + tempP%array3(indic(1), indic(2), & + indic(3)) = Res/Nbvals + CASE (4) + tempP%array4(indic(1), indic(2), & + indic(3), indic(4)) = Res/Nbvals + CASE (5) + tempP%array5(indic(1), indic(2), & + indic(3), indic(4), & + indic(5)) = Res/Nbvals + CASE (6) + tempP%array6(indic(1), indic(2), & + indic(3), indic(4), & + indic(5), indic(6)) = Res/Nbvals + END SELECT + exit + else + if (firsttest) exit + i = i + 1 + endif +! + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine CalculNewValTempP +!=================================================================================================== +! +!=================================================================================================== +! subroutine CalculNewValTempP3D +! +!> Called in the procedure #Agrif_InterpnD to recalculate the value of the parent grid variable +!! when this one is equal to Agrif_SpecialValue. +!--------------------------------------------------------------------------------------------------- +subroutine CalculNewValTempP3D ( indic, tempP, parent, ppbtab, ppetab, noraftab, & + MaxSearch, Agrif_SpecialValue ) +!--------------------------------------------------------------------------------------------------- + integer, parameter :: nbdim = 3 + integer, dimension(nbdim) :: indic + integer, dimension(nbdim) :: ppbtab, ppetab + logical, dimension(nbdim) :: noraftab + integer :: MaxSearch + real :: Agrif_SpecialValue + real, dimension(ppbtab(1):ppetab(1), & + ppbtab(2):ppetab(2), & + ppbtab(3):ppetab(3)) & + :: tempP, parent !< Part of the parent grid used for + !< the interpolation of the child grid +! + integer :: i,ii,iii,jj,kk + integer, dimension(nbdim) :: imin,imax,idecal + integer :: Nbvals + real :: Res + real :: ValParent + integer :: ValMax + logical :: Existunmasked +! + ValMax = 1 +!CDIR NOVECTOR + do iii = 1,nbdim + if (.NOT.noraftab(iii)) then + ValMax = max(ValMax,ppetab(iii)-indic(iii)) + ValMax = max(ValMax,indic(iii)-ppbtab(iii)) + endif + enddo +! + Valmax = min(Valmax,MaxSearch) +! +!CDIR NOVECTOR + imin = indic +!CDIR NOVECTOR + imax = indic + +!CDIR NOVECTOR + idecal = indic + i = Valmax +! + do iii = 1,nbdim + if (.NOT.noraftab(iii)) then + imin(iii) = max(indic(iii) - i,ppbtab(iii)) + imax(iii) = min(indic(iii) + i,ppetab(iii)) + + if (indic(iii) > ppbtab(iii)) then + idecal(iii) = idecal(iii)-1 + if (tempP(idecal(1),idecal(2),idecal(3)) == Agrif_SpecialValue) then + imin(iii) = imax(iii) + endif + idecal(iii) = idecal(iii)+1 + endif + endif + enddo +! + Existunmasked = .FALSE. +! + do kk = imin(3),imax(3) + do jj = imin(2),imax(2) +!CDIR NOVECTOR + do ii = imin(1),imax(1) + if ( parent(ii,jj,kk) /= Agrif_SpecialValue) then + Existunmasked = .TRUE. + exit + endif + enddo + enddo + enddo +! + if (.Not.Existunmasked) return +! + i = 1 +! + do while(i <= ValMax) +! + do iii = 1 , nbdim + if (.NOT.noraftab(iii)) then + imin(iii) = max(indic(iii) - i,ppbtab(iii)) + imax(iii) = min(indic(iii) + i,ppetab(iii)) + endif + enddo +! + Res = 0. + Nbvals = 0 +! + do kk = imin(3),imax(3) + do jj = imin(2),imax(2) +!CDIR NOVECTOR + do ii = imin(1),imax(1) + ValParent = parent(ii,jj,kk) + if ( ValParent /= Agrif_SpecialValue) then + Res = Res + ValParent + Nbvals = Nbvals + 1 + endif + enddo + enddo + enddo +! + if (Nbvals > 0) then + tempP(indic(1),indic(2),indic(3)) = Res/Nbvals + exit + else + i = i + 1 + endif + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine CalculNewValTempP3D +!=================================================================================================== +! +!=================================================================================================== +! subroutine CalculNewValTempP4D +! +!> Called in the procedure #Agrif_InterpnD to recalculate the value of the parent grid variable +!! when this one is equal to Agrif_SpecialValue. +!--------------------------------------------------------------------------------------------------- +subroutine CalculNewValTempP4D ( indic, tempP, parent, ppbtab, ppetab, noraftab, & + MaxSearch, Agrif_SpecialValue ) +!--------------------------------------------------------------------------------------------------- + integer, parameter :: nbdim = 4 + integer, dimension(nbdim) :: indic + integer, dimension(nbdim) :: ppbtab, ppetab + logical, dimension(nbdim) :: noraftab + integer :: MaxSearch + real :: Agrif_SpecialValue + real, dimension(ppbtab(1):ppetab(1), & + ppbtab(2):ppetab(2), & + ppbtab(3):ppetab(3), & + ppbtab(4):ppetab(4)) & + :: tempP, parent !< Part of the parent grid used for + !< the interpolation of the child grid +! + integer :: i,ii,iii,jj,kk,ll + integer, dimension(nbdim) :: imin,imax,idecal + integer :: Nbvals + real :: Res + real :: ValParent + integer :: ValMax +! + logical :: firsttest +! + ValMax = 1 + do iii = 1,nbdim + if (.NOT.noraftab(iii)) then + ValMax = max(ValMax,ppetab(iii)-indic(iii)) + ValMax = max(ValMax,indic(iii)-ppbtab(iii)) + endif + enddo +! + Valmax = min(Valmax,MaxSearch) +! + imin = indic + imax = indic +! + i = 1 + firsttest = .TRUE. + idecal = indic +! + do while (i <= ValMax) +! + if ((i == 1).AND.(firsttest)) i = Valmax + + do iii = 1,nbdim + if (.NOT.noraftab(iii)) then + imin(iii) = max(indic(iii) - i,ppbtab(iii)) + imax(iii) = min(indic(iii) + i,ppetab(iii)) + if (firsttest) then + if (indic(iii) > ppbtab(iii)) then + idecal(iii) = idecal(iii)-1 + if (tempP(idecal(1),idecal(2),idecal(3),idecal(4)) == Agrif_SpecialValue) then + imin(iii) = imax(iii) + endif + idecal(iii) = idecal(iii)+1 + endif + endif + endif + enddo +! + Res = 0. + Nbvals = 0 +! + do ll = imin(4),imax(4) + do kk = imin(3),imax(3) + do jj = imin(2),imax(2) + do ii = imin(1),imax(1) + ValParent = parent(ii,jj,kk,ll) + if ( ValParent /= Agrif_SpecialValue) then + Res = Res + ValParent + Nbvals = Nbvals + 1 + endif + enddo + enddo + enddo + enddo +! + if (Nbvals > 0) then + if (firsttest) then + firsttest = .FALSE. + i=1 + cycle + endif + + tempP(indic(1),indic(2),indic(3),indic(4)) = Res/Nbvals + exit + else + if (firsttest) exit + i = i + 1 + endif + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine CalculNewValTempP4D +!=================================================================================================== +! +end module Agrif_Mask diff --git a/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modmpp.F90 b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modmpp.F90 new file mode 100644 index 00000000..d7c04d92 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modmpp.F90 @@ -0,0 +1,636 @@ +! +! $Id: modmpp.F 779 2007-12-22 17:04:17Z rblod $ +! +! AGRIF (Adaptive Grid Refinement In Fortran) +! +! Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr) +! Christophe Vouland (Christophe.Vouland@imag.fr) +! +! This program is free software; you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation; either version 2 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program; if not, write to the Free Software +! Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA. +! +! +module Agrif_Mpp +! + use Agrif_Arrays + use Agrif_Grids +! + implicit none +! + interface + subroutine Agrif_get_proc_info ( imin, imax, jmin, jmax ) + integer, intent(out) :: imin, imax + integer, intent(out) :: jmin, jmax + end subroutine Agrif_get_proc_info + end interface +! + integer, private :: Agrif_MPI_prec +! + private :: Agrif_get_proc_info +! +contains +! +#if defined AGRIF_MPI +!=================================================================================================== +! subroutine Agrif_MPI_Init +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_MPI_Init ( comm ) +!--------------------------------------------------------------------------------------------------- + integer, optional, intent(in) :: comm !< MPI communicator to be attached to the root grid. +! + include 'mpif.h' + integer :: code, ierr + logical :: mpi_was_called + integer :: current_mpi_prec +! + call MPI_INITIALIZED( mpi_was_called, code ) + if( code /= MPI_SUCCESS ) then + write(*,*) ': Error in routine mpi_initialized' + call MPI_ABORT( MPI_COMM_WORLD, code, ierr ) + endif + if( .not. mpi_was_called ) then + write(*,*) '### AGRIF Error : you should call Agrif_MPI_Init *after* MPI_Init.' + stop + endif + + current_mpi_prec = KIND(1.0) + if (current_mpi_prec == 4) then + Agrif_MPI_prec = MPI_REAL4 + else + Agrif_MPI_prec = MPI_REAL8 + endif +! + if ( present(comm) ) then + call Agrif_MPI_switch_comm(comm) + else + call Agrif_MPI_switch_comm(MPI_COMM_WORLD) + endif +! + Agrif_Mygrid % communicator = Agrif_mpi_comm +! + if ( Agrif_Parallel_sisters ) then + call Agrif_Init_ProcList( Agrif_Mygrid % proc_def_list, Agrif_Nbprocs ) + call Agrif_pl_copy( Agrif_Mygrid % proc_def_list, Agrif_Mygrid % required_proc_list ) + endif +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_MPI_Init +!=================================================================================================== +! +!=================================================================================================== +subroutine Agrif_MPI_switch_comm ( comm ) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: comm !< MPI communicator you want to switch to. +! + include 'mpif.h' + integer :: code + logical :: mpi_was_called +! + call MPI_INITIALIZED( mpi_was_called, code ) + if ( .not. mpi_was_called ) return +! + call MPI_COMM_SIZE(comm, Agrif_Nbprocs, code) + call MPI_COMM_RANK(comm, Agrif_ProcRank, code) + Agrif_mpi_comm = comm +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_MPI_switch_comm +!=================================================================================================== +! +!=================================================================================================== +function Agrif_MPI_get_grid_comm ( ) result ( comm ) +!--------------------------------------------------------------------------------------------------- + integer :: comm + comm = Agrif_Curgrid % communicator +!--------------------------------------------------------------------------------------------------- +end function Agrif_MPI_get_grid_comm +!=================================================================================================== +! +!=================================================================================================== +subroutine Agrif_MPI_set_grid_comm ( comm ) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: comm + Agrif_Curgrid % communicator = comm +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_MPI_set_grid_comm +!=================================================================================================== +! +!=================================================================================================== +subroutine Agrif_Init_ProcList ( proclist, nbprocs ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Proc_List), intent(inout) :: proclist + integer, intent(in) :: nbprocs +! + include 'mpif.h' + type(Agrif_Proc), pointer :: new_proc + integer :: p, ierr + integer :: imin, imax, jmin, jmax + integer, dimension(5) :: local_proc_grid_info + integer, dimension(5,nbprocs) :: all_procs_grid_info +! + call Agrif_get_proc_info(imin, imax, jmin, jmax) +! + local_proc_grid_info(:) = (/Agrif_Procrank, imin, jmin, imax, jmax/) +! + call MPI_ALLGATHER(local_proc_grid_info, 5, MPI_INTEGER, & + all_procs_grid_info, 5, MPI_INTEGER, Agrif_mpi_comm, ierr) +! + do p = 1,nbprocs +! + allocate(new_proc) + new_proc % pn = all_procs_grid_info(1,p) + new_proc % imin(1) = all_procs_grid_info(2,p) + new_proc % imin(2) = all_procs_grid_info(3,p) + new_proc % imax(1) = all_procs_grid_info(4,p) + new_proc % imax(2) = all_procs_grid_info(5,p) + call Agrif_pl_append( proclist, new_proc ) +! + enddo +! +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Init_ProcList +!=================================================================================================== +! +!=================================================================================================== +! subroutine Get_External_Data_first +!--------------------------------------------------------------------------------------------------- +subroutine Get_External_Data_first ( pttruetab, cetruetab, pttruetabwhole, cetruetabwhole, & + nbdim, memberoutall, coords, sendtoproc, recvfromproc, & + imin, imax, imin_recv, imax_recv, bornesmin, bornesmax ) +!--------------------------------------------------------------------------------------------------- + include 'mpif.h' +! + integer, intent(in) :: nbdim + integer, dimension(nbdim,0:Agrif_NbProcs-1), intent(in) :: pttruetab, cetruetab + integer, dimension(nbdim,0:Agrif_NbProcs-1), intent(in) :: pttruetabwhole,cetruetabwhole + logical, dimension(0:Agrif_Nbprocs-1), intent(in) :: memberoutall + integer, dimension(nbdim), intent(in) :: coords + logical, dimension(0:Agrif_Nbprocs-1), intent(out) :: sendtoproc + logical, dimension(0:Agrif_Nbprocs-1), intent(out) :: recvfromproc + integer, dimension(nbdim,0:Agrif_NbProcs-1), intent(out) :: imin,imax + integer, dimension(nbdim,0:Agrif_NbProcs-1), intent(out) :: imin_recv,imax_recv + integer, dimension(nbdim,0:Agrif_NbProcs-1), intent(in) :: bornesmin, bornesmax +! + integer :: imintmp, imaxtmp, i, j, k, i1 + integer :: imin1,imax1 + logical :: tochange,tochangebis + integer, dimension(nbdim,0:Agrif_NbProcs-1) :: pttruetab2,cetruetab2 +! +! pttruetab2 and cetruetab2 are modified arrays in order to always +! send the most inner points +! + pttruetab2(:,Agrif_Procrank) = pttruetab(:,Agrif_Procrank) + cetruetab2(:,Agrif_Procrank) = cetruetab(:,Agrif_Procrank) +! + do k = 0,Agrif_Nbprocs-1 + do i = 1,nbdim + tochangebis = .TRUE. + DO i1 = 1,nbdim + IF (i /= i1) THEN + IF ( (pttruetab(i1,Agrif_Procrank) /= pttruetab(i1,k)) .OR. & + (cetruetab(i1,Agrif_Procrank) /= cetruetab(i1,k))) THEN + tochangebis = .FALSE. + EXIT + ENDIF + ENDIF + ENDDO + IF (tochangebis) THEN + imin1 = max(pttruetab(i,Agrif_Procrank), pttruetab(i,k)) + imax1 = min(cetruetab(i,Agrif_Procrank), cetruetab(i,k)) +! Always send the most interior points + + tochange = .false. + IF (cetruetab(i,Agrif_Procrank) > cetruetab(i,k)) THEN + DO j=imin1,imax1 + IF ((bornesmax(i,k)-j) > (j-bornesmin(i,Agrif_Procrank))) THEN + imintmp = j+1 + tochange = .TRUE. + ELSE + EXIT + ENDIF + ENDDO + ENDIF + + if (tochange) then + pttruetab2(i,Agrif_Procrank) = imintmp + endif + + tochange = .FALSE. + imaxtmp=0 + IF (pttruetab(i,Agrif_Procrank) < pttruetab(i,k)) THEN + DO j=imax1,imin1,-1 + IF ((j-bornesmin(i,k)) > (bornesmax(i,Agrif_Procrank)-j)) THEN + imaxtmp = j-1 + tochange = .TRUE. + ELSE + EXIT + ENDIF + ENDDO + ENDIF + + if (tochange) then + cetruetab2(i,Agrif_Procrank) = imaxtmp + endif + ENDIF + enddo + enddo + + do k = 0,Agrif_NbProcs-1 +! + sendtoproc(k) = .true. +! + IF ( .not. memberoutall(k) ) THEN + sendtoproc(k) = .false. + ELSE +!CDIR SHORTLOOP + do i = 1,nbdim + imin(i,k) = max(pttruetab2(i,Agrif_Procrank), pttruetabwhole(i,k)) + imax(i,k) = min(cetruetab2(i,Agrif_Procrank), cetruetabwhole(i,k)) +! + if ( (imin(i,k) > imax(i,k)) .and. (coords(i) /= 0) ) then + sendtoproc(k) = .false. + endif + enddo + ENDIF + enddo +! + call Exchangesamelevel_first(sendtoproc,nbdim,imin,imax,recvfromproc,imin_recv,imax_recv) +!--------------------------------------------------------------------------------------------------- +end subroutine Get_External_Data_first +!=================================================================================================== +! +!=================================================================================================== +! subroutine ExchangeSameLevel_first +!--------------------------------------------------------------------------------------------------- +subroutine ExchangeSameLevel_first ( sendtoproc, nbdim, imin, imax, recvfromproc, & + imin_recv, imax_recv ) +!--------------------------------------------------------------------------------------------------- + LOGICAL, DIMENSION(0:Agrif_Nbprocs-1), intent(in) :: sendtoproc + INTEGER, intent(in) :: nbdim + INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(in) :: imin + INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(in) :: imax + LOGICAL, DIMENSION(0:Agrif_Nbprocs-1), intent(out) :: recvfromproc + INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(out) :: imin_recv + INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(out) :: imax_recv +! + include 'mpif.h' + INTEGER :: k + INTEGER :: etiquette = 100 + INTEGER :: code + LOGICAL :: res + INTEGER, DIMENSION(MPI_STATUS_SIZE) :: statut + INTEGER, DIMENSION(nbdim,2,0:Agrif_Nbprocs-1) :: iminmax_temp + + do k = 0,Agrif_ProcRank-1 +! + call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette,Agrif_mpi_comm,code) +! + if (sendtoproc(k)) then + iminmax_temp(:,1,k) = imin(:,k) + iminmax_temp(:,2,k) = imax(:,k) + call MPI_SEND(iminmax_temp(:,:,k),2*nbdim,MPI_INTEGER,k,etiquette,Agrif_mpi_comm,code) + endif +! + enddo +! +! Reception from others processors of the necessary part of the parent grid + do k = Agrif_ProcRank+1,Agrif_Nbprocs-1 +! + call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette,Agrif_mpi_comm,statut,code) + recvfromproc(k) = res +! + if (recvfromproc(k)) then + call MPI_RECV(iminmax_temp(:,:,k),2*nbdim,MPI_INTEGER,k,etiquette, & + Agrif_mpi_comm,statut,code) + imin_recv(:,k) = iminmax_temp(:,1,k) + imax_recv(:,k) = iminmax_temp(:,2,k) + endif +! + enddo + +! Reception from others processors of the necessary part of the parent grid + do k = Agrif_ProcRank+1,Agrif_Nbprocs-1 +! + call MPI_SEND(sendtoproc(k),1,MPI_LOGICAL,k,etiquette,Agrif_mpi_comm,code) +! + if (sendtoproc(k)) then +! + iminmax_temp(:,1,k) = imin(:,k) + iminmax_temp(:,2,k) = imax(:,k) + + call MPI_SEND(iminmax_temp(:,:,k),2*nbdim,MPI_INTEGER,k,etiquette, & + Agrif_mpi_comm,code) + endif +! + enddo +! +! +! Reception from others processors of the necessary part of the parent grid + do k = Agrif_ProcRank-1,0,-1 +! + call MPI_RECV(res,1,MPI_LOGICAL,k,etiquette,Agrif_mpi_comm,statut,code) + recvfromproc(k) = res +! + if (recvfromproc(k)) then +! + call MPI_RECV(iminmax_temp(:,:,k),2*nbdim,MPI_INTEGER,k,etiquette, & + Agrif_mpi_comm,statut,code) + + imin_recv(:,k) = iminmax_temp(:,1,k) + imax_recv(:,k) = iminmax_temp(:,2,k) + endif +! + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine ExchangeSamelevel_first +!=================================================================================================== +! +!=================================================================================================== +! subroutine ExchangeSameLevel +!--------------------------------------------------------------------------------------------------- +subroutine ExchangeSameLevel ( sendtoproc, recvfromproc, nbdim, & + pttruetabwhole, cetruetabwhole, & + imin, imax, imin_recv, imax_recv, & + memberout, tempC, tempCextend ) +!--------------------------------------------------------------------------------------------------- + LOGICAL, DIMENSION(0:Agrif_Nbprocs-1), intent(in) :: sendtoproc + LOGICAL, DIMENSION(0:Agrif_Nbprocs-1), intent(in) :: recvfromproc + INTEGER, intent(in) :: nbdim + INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(in) :: pttruetabwhole + INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(in) :: cetruetabwhole + INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(in) :: imin, imax + INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1), intent(in) :: imin_recv, imax_recv + LOGICAL, intent(in) :: memberout + TYPE(Agrif_Variable), pointer, intent(inout) :: tempC, tempCextend +! + include 'mpif.h' + INTEGER :: i,k + INTEGER :: etiquette = 100 + INTEGER :: code, datasize + INTEGER, DIMENSION(MPI_STATUS_SIZE) :: statut + TYPE(Agrif_Variable), pointer, SAVE :: temprecv +! + IF (memberout) THEN + call Agrif_array_allocate(tempCextend, pttruetabwhole(:,Agrif_ProcRank), & + cetruetabwhole(:,Agrif_ProcRank),nbdim) + call Agrif_var_set_array_tozero(tempCextend,nbdim) + ENDIF +! + IF (sendtoproc(Agrif_ProcRank)) THEN + call Agrif_var_copy_array(tempCextend,imin(:,Agrif_Procrank),imax(:,Agrif_Procrank), & + tempC, imin(:,Agrif_Procrank),imax(:,Agrif_Procrank), & + nbdim) + ENDIF +! + do k = 0,Agrif_ProcRank-1 +! + if (sendtoproc(k)) then +! + datasize = 1 +! +!CDIR SHORTLOOP + do i = 1,nbdim + datasize = datasize * (imax(i,k)-imin(i,k)+1) + enddo +! + SELECT CASE(nbdim) + CASE(1) + call MPI_SEND(tempC%array1(imin(1,k):imax(1,k)), & + datasize,Agrif_MPI_prec,k,etiquette, & + Agrif_mpi_comm,code) + CASE(2) + call MPI_SEND(tempC%array2(imin(1,k):imax(1,k), & + imin(2,k):imax(2,k)), & + datasize,Agrif_MPI_prec,k,etiquette, & + Agrif_mpi_comm,code) + CASE(3) + call Agrif_Send_3Darray(tempC%array3,lbound(tempC%array3),imin(:,k),imax(:,k),k) + CASE(4) + call MPI_SEND(tempC%array4(imin(1,k):imax(1,k), & + imin(2,k):imax(2,k), & + imin(3,k):imax(3,k), & + imin(4,k):imax(4,k)), & + datasize,Agrif_MPI_prec,k,etiquette, & + Agrif_mpi_comm,code) + CASE(5) + call MPI_SEND(tempC%array5(imin(1,k):imax(1,k), & + imin(2,k):imax(2,k), & + imin(3,k):imax(3,k), & + imin(4,k):imax(4,k), & + imin(5,k):imax(5,k)), & + datasize,Agrif_MPI_prec,k,etiquette, & + Agrif_mpi_comm,code) + CASE(6) + call MPI_SEND(tempC%array6(imin(1,k):imax(1,k), & + imin(2,k):imax(2,k), & + imin(3,k):imax(3,k), & + imin(4,k):imax(4,k), & + imin(5,k):imax(5,k), & + imin(6,k):imax(6,k)), & + datasize,Agrif_MPI_prec,k,etiquette, & + Agrif_mpi_comm,code) + END SELECT +! + endif + enddo +! +! Reception from others processors of the necessary part of the parent grid + do k = Agrif_ProcRank+1,Agrif_Nbprocs-1 +! + if (recvfromproc(k)) then +! + datasize = 1 +! +!CDIR SHORTLOOP + do i = 1,nbdim + datasize = datasize * (imax_recv(i,k)-imin_recv(i,k)+1) + enddo + + if (.not.associated(temprecv)) allocate(temprecv) + call Agrif_array_allocate(temprecv,imin_recv(:,k),imax_recv(:,k),nbdim) + + SELECT CASE(nbdim) + CASE(1) + call MPI_RECV(temprecv%array1,datasize,Agrif_MPI_prec,k,etiquette, & + Agrif_mpi_comm,statut,code) + CASE(2) + call MPI_RECV(temprecv%array2,datasize,Agrif_MPI_prec,k,etiquette, & + Agrif_mpi_comm,statut,code) + CASE(3) + call MPI_RECV(temprecv%array3,datasize,Agrif_MPI_prec,k,etiquette, & + Agrif_mpi_comm,statut,code) + CASE(4) + call MPI_RECV(temprecv%array4,datasize,Agrif_MPI_prec,k,etiquette, & + Agrif_mpi_comm,statut,code) + CASE(5) + call MPI_RECV(temprecv%array5,datasize,Agrif_MPI_prec,k,etiquette, & + Agrif_mpi_comm,statut,code) + CASE(6) + call MPI_RECV(temprecv%array6,datasize,Agrif_MPI_prec,k,etiquette, & + Agrif_mpi_comm,statut,code) + END SELECT + + call Agrif_var_replace_value(tempCextend,temprecv,imin_recv(:,k),imax_recv(:,k),0.,nbdim) + call Agrif_array_deallocate(temprecv,nbdim) +! + endif + enddo + +! Reception from others processors of the necessary part of the parent grid + do k = Agrif_ProcRank+1,Agrif_Nbprocs-1 +! + if (sendtoproc(k)) then +! + SELECT CASE(nbdim) + CASE(1) + datasize=SIZE(tempC%array1(imin(1,k):imax(1,k))) + call MPI_SEND(tempC%array1(imin(1,k):imax(1,k)), & + datasize,Agrif_MPI_prec,k,etiquette, & + Agrif_mpi_comm,code) + CASE(2) + datasize=SIZE(tempC%array2(imin(1,k):imax(1,k), & + imin(2,k):imax(2,k))) + call MPI_SEND(tempC%array2(imin(1,k):imax(1,k), & + imin(2,k):imax(2,k)), & + datasize,Agrif_MPI_prec,k,etiquette, & + Agrif_mpi_comm,code) + CASE(3) + datasize=SIZE(tempC%array3(imin(1,k):imax(1,k), & + imin(2,k):imax(2,k), & + imin(3,k):imax(3,k))) + call MPI_SEND(tempC%array3(imin(1,k):imax(1,k), & + imin(2,k):imax(2,k), & + imin(3,k):imax(3,k)), & + datasize,Agrif_MPI_prec,k,etiquette, & + Agrif_mpi_comm,code) + CASE(4) + datasize=SIZE(tempC%array4(imin(1,k):imax(1,k), & + imin(2,k):imax(2,k), & + imin(3,k):imax(3,k), & + imin(4,k):imax(4,k))) + call MPI_SEND(tempC%array4(imin(1,k):imax(1,k), & + imin(2,k):imax(2,k), & + imin(3,k):imax(3,k), & + imin(4,k):imax(4,k)), & + datasize,Agrif_MPI_prec,k,etiquette, & + Agrif_mpi_comm,code) + CASE(5) + datasize=SIZE(tempC%array5(imin(1,k):imax(1,k), & + imin(2,k):imax(2,k), & + imin(3,k):imax(3,k), & + imin(4,k):imax(4,k), & + imin(5,k):imax(5,k))) + call MPI_SEND(tempC%array5(imin(1,k):imax(1,k), & + imin(2,k):imax(2,k), & + imin(3,k):imax(3,k), & + imin(4,k):imax(4,k), & + imin(5,k):imax(5,k)), & + datasize,Agrif_MPI_prec,k,etiquette, & + Agrif_mpi_comm,code) + CASE(6) + datasize=SIZE(tempC%array6(imin(1,k):imax(1,k), & + imin(2,k):imax(2,k), & + imin(3,k):imax(3,k), & + imin(4,k):imax(4,k), & + imin(5,k):imax(5,k), & + imin(6,k):imax(6,k))) + call MPI_SEND(tempC%array6(imin(1,k):imax(1,k), & + imin(2,k):imax(2,k), & + imin(3,k):imax(3,k), & + imin(4,k):imax(4,k), & + imin(5,k):imax(5,k), & + imin(6,k):imax(6,k)), & + datasize,Agrif_MPI_prec,k,etiquette, & + Agrif_mpi_comm,code) + END SELECT +! + endif +! + enddo +! +! Reception from others processors of the necessary part of the parent grid + do k = Agrif_ProcRank-1,0,-1 +! + if (recvfromproc(k)) then +! + if (.not.associated(temprecv)) allocate(temprecv) + call Agrif_array_allocate(temprecv,imin_recv(:,k),imax_recv(:,k),nbdim) + + SELECT CASE(nbdim) + CASE(1) + datasize=SIZE(temprecv%array1) + call MPI_RECV(temprecv%array1,datasize,Agrif_MPI_prec,k,etiquette,& + Agrif_mpi_comm,statut,code) + CASE(2) + datasize=SIZE(temprecv%array2) + call MPI_RECV(temprecv%array2,datasize,Agrif_MPI_prec,k,etiquette,& + Agrif_mpi_comm,statut,code) + CASE(3) + datasize=SIZE(temprecv%array3) + call MPI_RECV(temprecv%array3,datasize,Agrif_MPI_prec,k,etiquette,& + Agrif_mpi_comm,statut,code) + CASE(4) + datasize=SIZE(temprecv%array4) + call MPI_RECV(temprecv%array4,datasize,Agrif_MPI_prec,k,etiquette,& + Agrif_mpi_comm,statut,code) + CASE(5) + datasize=SIZE(temprecv%array5) + call MPI_RECV(temprecv%array5,datasize,Agrif_MPI_prec,k,etiquette,& + Agrif_mpi_comm,statut,code) + CASE(6) + datasize=SIZE(temprecv%array6) + call MPI_RECV(temprecv%array6,datasize,Agrif_MPI_prec,k,etiquette,& + Agrif_mpi_comm,statut,code) + END SELECT + + call Agrif_var_replace_value(tempCextend,temprecv,imin_recv(:,k),imax_recv(:,k),0.,nbdim) + call Agrif_array_deallocate(temprecv,nbdim) +! + endif +! + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine ExchangeSamelevel +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Send_3Darray +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Send_3Darray ( tab3D, bounds, imin, imax, k ) +!--------------------------------------------------------------------------------------------------- + integer, dimension(3), intent(in) :: bounds + real, dimension(bounds(1):,bounds(2):,bounds(3):), target, intent(in) :: tab3D + integer, dimension(3), intent(in) :: imin, imax + integer, intent(in) :: k +! + integer :: etiquette = 100 + integer :: datasize, code + include 'mpif.h' + + datasize = SIZE(tab3D(imin(1):imax(1), & + imin(2):imax(2), & + imin(3):imax(3))) + + call MPI_SEND( tab3D( imin(1):imax(1), & + imin(2):imax(2), & + imin(3):imax(3)), & + datasize,Agrif_MPI_prec,k,etiquette,Agrif_mpi_comm,code) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Send_3Darray +!=================================================================================================== +! +#else + subroutine dummy_Agrif_Mpp () + end subroutine dummy_Agrif_Mpp +#endif +! +end Module Agrif_Mpp diff --git a/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modprocs.F90 b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modprocs.F90 new file mode 100644 index 00000000..d9524d8a --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modprocs.F90 @@ -0,0 +1,208 @@ +module Agrif_Procs +! + implicit none +! + type Agrif_Proc + integer :: pn !< Proc index in coarse grid + integer :: pi !< Proc index in x-direction (informative only, could be removed) + integer :: pj !< Proc index in y-direction (informative only, could be removed) + integer, dimension(3) :: imin + integer, dimension(3) :: imax + integer :: nb_seqs = 0 !< Number of integration sequences the proc is attached to. + integer :: grid_id = 0 !< Grid id the proc is attached to. + end type Agrif_Proc +! + type Agrif_Proc_p + type(Agrif_Proc), pointer :: proc => NULL() !< Pointer to the actual proc structure + type(Agrif_Proc_p), pointer :: next => NULL() !< Next proc in the list + end type Agrif_Proc_p +! + type Agrif_Proc_List + integer :: nitems = 0 !< Number of elements in the list + type(Agrif_Proc_p), pointer :: first => NULL() !< First proc in the list + type(Agrif_Proc_p), pointer :: last => NULL() !< Last proc inserted in the list + end type Agrif_Proc_List +! +contains +! +!=================================================================================================== +subroutine Agrif_pl_append ( proclist, proc ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Proc_List), intent(inout) :: proclist + type(Agrif_Proc), pointer, intent(in) :: proc +! + type(Agrif_Proc_p), pointer :: new_pp +! + allocate( new_pp ) +! + new_pp % proc => proc + new_pp % next => NULL() +! + if ( associated(proclist % last) ) then + ! the list is not empty, let 'proc' be the next after the last (ie. the last one). + proclist % last % next => new_pp + else + ! the list has just been initialized. Let 'proc' be the first one. + proclist % first => new_pp + endif + ! anyway, for next time 'proc' will be the last one. + proclist % last => new_pp + proclist % nitems = proclist % nitems + 1 +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_pl_append +!=================================================================================================== +! +!=================================================================================================== +subroutine Agrif_pl_print_array ( proclist ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Proc_List), intent(in) :: proclist +! + type(Agrif_Proc_p), pointer :: pp + type(Agrif_Proc), pointer :: proc +! + pp => proclist % first +! + write(*,'("/-------+-----+-----+------+------+------+------+------\")') + write(*,'("| iproc | ipx | ipy | imin | imax | jmin | jmax | grid |")') + write(*,'("|-------+-----+-----+------+------+------+------+------|")') + do while ( associated(pp) ) + proc => pp % proc + write(*,'("|",i6," |",i4," |",i4," |",i5," :",i5," |",i5," :",i5," | ",i4," |")') & + proc % pn, proc % pi, proc % pj, proc % imin(1), proc % imax(1), proc % imin(2), proc % imax(2), & + proc % grid_id + pp => pp % next + enddo + write(*,'("\-------+-----+-----+------+------+------+------+------/")') +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_pl_print_array +!=================================================================================================== +! +!=================================================================================================== +subroutine Agrif_pl_print ( proclist ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Proc_List), intent(in) :: proclist +! + type(Agrif_Proc_p), pointer :: pp +! + pp => proclist % first + do while ( associated(pp) ) + write(*,'(i0,",")',advance='no') pp % proc % pn + pp => pp % next + enddo + write(*,*) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_pl_print +!=================================================================================================== +! +!=================================================================================================== +subroutine Agrif_pl_copy ( proclist, copy ) +! +!< Carries out a copy of 'proclist' into 'copy' +!--------------------------------------------------------------------------------------------------- + type(Agrif_Proc_List), intent(in) :: proclist + type(Agrif_Proc_List), intent(out) :: copy +! + type(Agrif_Proc_p), pointer :: pp +! + call Agrif_pl_clear(copy) +! + pp => proclist % first + do while ( associated(pp) ) + call Agrif_pl_append( copy, pp % proc ) + pp => pp % next + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_pl_copy +!=================================================================================================== +! +!=================================================================================================== +subroutine Agrif_pl_deep_copy ( proclist, copy ) +! +!< Carries out a deep copy of 'proclist' into 'copy' +!--------------------------------------------------------------------------------------------------- + type(Agrif_Proc_List), intent(in) :: proclist + type(Agrif_Proc_List), intent(out) :: copy +! + type(Agrif_Proc_p), pointer :: pp + type(Agrif_Proc), pointer :: new_proc +! + call Agrif_pl_clear(copy) +! + pp => proclist % first + do while ( associated(pp) ) + allocate( new_proc ) + new_proc = pp % proc + call Agrif_pl_append( copy, new_proc ) + pp => pp % next + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_pl_deep_copy +!=================================================================================================== +! +!=================================================================================================== +subroutine Agrif_pl_clear ( proclist ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Proc_List), intent(inout) :: proclist +! + type(Agrif_Proc_p), pointer :: pp, ppd +! + pp => proclist % first +! + do while( associated(pp) ) + ppd => pp + pp => pp % next + deallocate(ppd) + enddo + + proclist % first => NULL() + proclist % last => NULL() + proclist % nitems = 0 +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_pl_clear +!=================================================================================================== +! +!=================================================================================================== +subroutine Agrif_pl_to_array ( proclist, procarray ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Proc_List), intent(in) :: proclist + type(Agrif_Proc), dimension(:), allocatable, intent(out) :: procarray +! + type(Agrif_Proc_p), pointer :: pp +! + allocate( procarray(1:proclist % nitems) ) +! + pp => proclist % first + do while ( associated(pp) ) + procarray(pp%proc%pn+1) = pp % proc + pp => pp % next + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_pl_to_array +!=================================================================================================== +! +!=================================================================================================== +function Agrif_pl_search_proc ( proclist, rank ) result ( proc ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Proc_List), intent(in) :: proclist + integer, intent(in) :: rank +! + type(Agrif_Proc_p), pointer :: pp + type(Agrif_Proc), pointer :: proc + logical :: found +! + found = .false. + proc => NULL() + pp => proclist % first + do while ( .not.found .and. associated(pp) ) + if ( pp % proc % pn == rank ) then + proc => pp % proc + return + else + pp => pp % next + endif + enddo +!--------------------------------------------------------------------------------------------------- +end function Agrif_pl_search_proc +!=================================================================================================== +! +end module Agrif_Procs diff --git a/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modsauv.F90 b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modsauv.F90 new file mode 100644 index 00000000..5d8a6a4c --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modsauv.F90 @@ -0,0 +1,663 @@ +! +! $Id: modsauv.F 662 2007-05-25 15:58:52Z opalod $ +! +! AGRIF (Adaptive Grid Refinement In Fortran) +! +! Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr) +! Christophe Vouland (Christophe.Vouland@imag.fr) +! +! This program is free software; you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation; either version 2 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program; if not, write to the Free Software +! Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA. +! +! +!> Module Agrif_Save +!! +!! Module for the initialization by copy of the grids created by clustering. +! +module Agrif_Save +! + use Agrif_Types + use Agrif_Link + use Agrif_Arrays + use Agrif_Variables +! + implicit none +! +contains +! +!=================================================================================================== +! subroutine Agrif_deallocate_Arrays +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_deallocate_Arrays ( var ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Variable), pointer :: var +! + if (allocated(var%array1)) deallocate(var%array1) + if (allocated(var%array2)) deallocate(var%array2) + if (allocated(var%array3)) deallocate(var%array3) + if (allocated(var%array4)) deallocate(var%array4) + if (allocated(var%array5)) deallocate(var%array5) + if (allocated(var%array6)) deallocate(var%array6) +! + if (allocated(var%darray1)) deallocate(var%darray1) + if (allocated(var%darray2)) deallocate(var%darray2) + if (allocated(var%darray3)) deallocate(var%darray3) + if (allocated(var%darray4)) deallocate(var%darray4) + if (allocated(var%darray5)) deallocate(var%darray5) + if (allocated(var%darray6)) deallocate(var%darray6) +! + if (allocated(var%sarray1)) deallocate(var%sarray1) + if (allocated(var%sarray2)) deallocate(var%sarray2) + if (allocated(var%sarray3)) deallocate(var%sarray3) + if (allocated(var%sarray4)) deallocate(var%sarray4) + if (allocated(var%sarray5)) deallocate(var%sarray5) + if (allocated(var%sarray6)) deallocate(var%sarray6) +! +! + if (associated(var%oldvalues2D)) deallocate(var%oldvalues2D) + if (allocated(var%posvar)) deallocate(var%posvar) + if (allocated(var%interptab)) deallocate(var%interptab) + if (allocated(var%coords)) deallocate(var%coords) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_deallocate_Arrays +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_deallocate_Arrays_c ( var_c ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Variable_c), pointer :: var_c +! + if (allocated(var_c%carray1)) deallocate(var_c%carray1) + if (allocated(var_C%carray2)) deallocate(var_c%carray2) +! +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_deallocate_Arrays_c +!=================================================================================================== +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_deallocate_Arrays_l ( var_l ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Variable_l), pointer :: var_l +! +! + if (allocated(var_l%larray1)) deallocate(var_l%larray1) + if (allocated(var_l%larray2)) deallocate(var_l%larray2) + if (allocated(var_l%larray3)) deallocate(var_l%larray3) + if (allocated(var_l%larray4)) deallocate(var_l%larray4) + if (allocated(var_l%larray5)) deallocate(var_l%larray5) + if (allocated(var_l%larray6)) deallocate(var_l%larray6) +! +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_deallocate_Arrays_l +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_deallocate_Arrays_i ( var_i ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Variable_i), pointer :: var_i +! +! + if (allocated(var_i%iarray1)) deallocate(var_i%iarray1) + if (allocated(var_i%iarray2)) deallocate(var_i%iarray2) + if (allocated(var_i%iarray3)) deallocate(var_i%iarray3) + if (allocated(var_i%iarray4)) deallocate(var_i%iarray4) + if (allocated(var_i%iarray5)) deallocate(var_i%iarray5) + if (allocated(var_i%iarray6)) deallocate(var_i%iarray6) +! +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_deallocate_Arrays_i +! +!=================================================================================================== +! subroutine Agrif_Free_data_before +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Free_data_before ( Agrif_Gr ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid), pointer :: Agrif_Gr ! Pointer on the current grid +! + integer :: i + type(Agrif_Variables_List), pointer :: parcours + type(Agrif_Variable), pointer :: var + type(Agrif_Variable_c), pointer :: var_c + type(Agrif_Variable_r), pointer :: var_r + type(Agrif_Variable_l), pointer :: var_l + type(Agrif_Variable_i), pointer :: var_i +! + do i = 1,Agrif_NbVariables(0) +! + var => Agrif_Gr % tabvars(i) +! + if ( .NOT. Agrif_Mygrid % tabvars(i) % restore ) then + call Agrif_deallocate_Arrays(var) + endif +! + if (associated(var%list_interp)) then + call Agrif_Free_list_interp(var%list_interp) + endif +! + enddo + do i=1,Agrif_NbVariables(1) + var_c => Agrif_Gr % tabvars_c(i) + call Agrif_deallocate_Arrays_c(var_c) + enddo + do i=1,Agrif_NbVariables(3) + var_l => Agrif_Gr % tabvars_l(i) + call Agrif_deallocate_Arrays_l(var_l) + enddo + do i=1,Agrif_NbVariables(4) + var_i => Agrif_Gr % tabvars_i(i) + call Agrif_deallocate_Arrays_i(var_i) + enddo + + parcours => Agrif_Gr % variables + + do i = 1,Agrif_Gr%NbVariables +! + if ( .NOT. parcours%var%root_var % restore ) then + call Agrif_deallocate_Arrays(parcours%var) + endif +! + if (associated(parcours%var%list_interp)) then + call Agrif_Free_list_interp(parcours%var%list_interp) + endif +! + if ( .NOT. parcours%var%root_var % restore ) then + deallocate(parcours%var) + endif +! + parcours => parcours % next +! + enddo +! + if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) then + if ( Agrif_Probdim == 1 ) deallocate(Agrif_Gr%tabpoint1D) + if ( Agrif_Probdim == 2 ) deallocate(Agrif_Gr%tabpoint2D) + if ( Agrif_Probdim == 3 ) deallocate(Agrif_Gr%tabpoint3D) + endif +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Free_data_before +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Free_list_interp +!--------------------------------------------------------------------------------------------------- +recursive subroutine Agrif_Free_list_interp ( list_interp ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_List_Interp_Loc), pointer :: list_interp +! + if (associated(list_interp%suiv)) call Agrif_Free_list_interp(list_interp%suiv) + +#if defined AGRIF_MPI + deallocate(list_interp%interp_loc%tab4t) + deallocate(list_interp%interp_loc%memberinall) + deallocate(list_interp%interp_loc%sendtoproc1) + deallocate(list_interp%interp_loc%recvfromproc1) +#endif + deallocate(list_interp%interp_loc) + deallocate(list_interp) + nullify(list_interp) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Free_list_interp +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Free_data_after +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Free_data_after ( Agrif_Gr ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid), pointer :: Agrif_Gr !< Pointer on the current grid +! + integer :: i + type(Agrif_Variables_List), pointer :: parcours, rootparcours + type(Agrif_Variable), pointer :: var +! + do i = 1,Agrif_NbVariables(0) + if ( Agrif_Mygrid % tabvars(i) % restore ) then + var => Agrif_Gr%tabvars(i) + call Agrif_deallocate_Arrays(var) + endif + enddo +! + parcours => Agrif_Gr%variables + rootparcours => Agrif_Mygrid%variables +! + do i = 1,Agrif_Gr%NbVariables + if (rootparcours%var % restore ) then + call Agrif_deallocate_Arrays(parcours%var) + deallocate(parcours%var) + endif + parcours => parcours % next + rootparcours => rootparcours % next + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Free_data_after +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_CopyFromOld_All +! +!> Called in Agrif_Clustering#Agrif_Init_Hierarchy. +!--------------------------------------------------------------------------------------------------- +recursive subroutine Agrif_CopyFromOld_All ( g, oldchildlist ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid), pointer, intent(inout) :: g !< Pointer on the current grid + type(Agrif_Grid_List), intent(in) :: oldchildlist +! + type(Agrif_PGrid), pointer :: parcours ! Pointer for the recursive procedure + real :: g_eps, eps, oldgrid_eps + integer :: out + integer :: iii +! + out = 0 +! + parcours => oldchildlist % first +! + do while (associated(parcours)) +! + if ((.NOT. g % fixed) .AND. (parcours % gr %oldgrid)) then +! + g_eps = huge(1.) + oldgrid_eps = huge(1.) + do iii = 1,Agrif_Probdim + g_eps = min(g_eps,g % Agrif_dx(iii)) + oldgrid_eps = min(oldgrid_eps, parcours % gr % Agrif_dx(iii)) + enddo +! + eps = min(g_eps,oldgrid_eps)/100. +! + do iii = 1,Agrif_Probdim + if (g % Agrif_dx(iii) < (parcours % gr % Agrif_dx(iii) - eps)) then + parcours => parcours % next + out = 1 + exit + endif + enddo +! + if ( out == 1 ) cycle +! + call Agrif_CopyFromOld(g,parcours%gr) +! + endif +! + call Agrif_CopyFromOld_All(g,parcours % gr % child_list) +! + parcours => parcours % next +! + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_CopyFromOld_All +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_CopyFromOld +! +!> Call to the Agrif_Copy procedure. +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_CopyFromOld ( new_gr, old_gr ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid), pointer, intent(inout) :: new_gr !< Pointer on the current grid + type(Agrif_Grid), pointer, intent(inout) :: old_gr !< Pointer on an old grid +! + type(Agrif_Variable), pointer :: new_var + type(Agrif_Variable), pointer :: old_var + integer :: i +! + do i = 1,Agrif_NbVariables(0) + if ( Agrif_Mygrid % tabvars(i) % restore ) then + old_var => old_gr % tabvars(i) + new_var => new_gr % tabvars(i) + call Agrif_Copy(new_gr, old_gr, new_var, old_var ) + endif + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_CopyFromOld +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_CopyFromOld_AllOneVar +! +!> Called in Agrif_Clustering#Agrif_Init_Hierarchy. +!--------------------------------------------------------------------------------------------------- +recursive subroutine Agrif_CopyFromOld_AllOneVar ( g, oldchildlist, indic ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid), pointer, intent(inout) :: g !< Pointer on the current grid + type(Agrif_Grid_List), intent(in) :: oldchildlist + integer, intent(in) :: indic +! + type(Agrif_PGrid), pointer :: parcours ! Pointer for the recursive procedure + real :: g_eps,eps,oldgrid_eps + integer :: out + integer :: iii +! + out = 0 +! + parcours => oldchildlist % first +! + do while (associated(parcours)) +! + if ((.NOT. g % fixed) .AND. (parcours % gr %oldgrid)) then +! + g_eps = huge(1.) + oldgrid_eps = huge(1.) + do iii = 1,Agrif_Probdim + g_eps = min(g_eps,g % Agrif_dx(iii)) + oldgrid_eps = min(oldgrid_eps,parcours % gr % Agrif_dx(iii)) + enddo +! + eps = min(g_eps,oldgrid_eps)/100. +! + do iii = 1,Agrif_Probdim + if (g % Agrif_dx(iii) < (parcours % gr % Agrif_dx(iii) - eps)) then + parcours => parcours % next + out = 1 + exit + endif + enddo + + if ( out == 1 ) cycle +! + call Agrif_CopyFromOldOneVar(g,parcours%gr,indic) +! + endif +! + call Agrif_CopyFromOld_AllOneVar(g,parcours%gr % child_list,indic) +! + parcours => parcours % next +! + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_CopyFromOld_AllOneVar +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_CopyFromOldOneVar +! +!> Call to Agrif_Copy +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_CopyFromOldOneVar ( new_gr, old_gr, indic ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid), pointer, intent(inout) :: new_gr !< Pointer on the current grid + type(Agrif_Grid), pointer, intent(in) :: old_gr !< Pointer on an old grid + integer, intent(in) :: indic +! + type(Agrif_Variable), pointer :: new_var, old_var +! + new_var => Agrif_Search_Variable(new_gr, -indic) + old_var => Agrif_Search_Variable(old_gr, -indic) +! + call Agrif_array_allocate(new_var,new_var%lb,new_var%ub,new_var%nbdim) + call Agrif_Copy(new_gr, old_gr, new_var,old_var) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_CopyFromOldOneVar +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Copy +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Copy ( new_gr, old_gr, new_var, old_var ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid), pointer, intent(in) :: new_gr !< Pointer on the current grid + type(Agrif_Grid), pointer, intent(in) :: old_gr !< Pointer on an old grid + type(Agrif_Variable), pointer, intent(inout) :: new_var + type(Agrif_Variable), pointer, intent(in) :: old_var +! + type(Agrif_Variable), pointer :: root ! Pointer on the variable of the root grid + integer :: nbdim ! Number of dimensions of the current grid + integer, dimension(6) :: pttabnew ! Indexes of the first point in the domain + integer, dimension(6) :: petabnew ! Indexes of the first point in the domain + integer, dimension(6) :: pttabold ! Indexes of the first point in the domain + integer, dimension(6) :: petabold ! Indexes of the first point in the domain + integer, dimension(6) :: nbtabold ! Number of cells in each direction + integer, dimension(6) :: nbtabnew ! Number of cells in each direction + real, dimension(6) :: snew,sold + real, dimension(6) :: dsnew,dsold + real :: eps + integer :: n +! + root => new_var % root_var + nbdim = root % nbdim +! + do n = 1,nbdim +! + select case(root % interptab(n)) +! + case('x') +! + pttabnew(n) = root % point(n) + pttabold(n) = root % point(n) + snew(n) = new_gr % Agrif_x(1) + sold(n) = old_gr % Agrif_x(1) + dsnew(n) = new_gr % Agrif_dx(1) + dsold(n) = old_gr % Agrif_dx(1) +! + if (root % posvar(n) == 1) then + petabnew(n) = pttabnew(n) + new_gr % nb(1) + petabold(n) = pttabold(n) + old_gr % nb(1) + else + petabnew(n) = pttabnew(n) + new_gr % nb(1) - 1 + petabold(n) = pttabold(n) + old_gr % nb(1) - 1 + snew(n) = snew(n) + dsnew(n)/2. + sold(n) = sold(n) + dsold(n)/2. + endif +! + case('y') +! + pttabnew(n) = root % point(n) + pttabold(n) = root % point(n) + snew(n) = new_gr % Agrif_x(2) + sold(n) = old_gr % Agrif_x(2) + dsnew(n) = new_gr % Agrif_dx(2) + dsold(n) = old_gr % Agrif_dx(2) +! + if (root % posvar(n) == 1) then + petabnew(n) = pttabnew(n) + new_gr % nb(2) + petabold(n) = pttabold(n) + old_gr % nb(2) + else + petabnew(n) = pttabnew(n) + new_gr % nb(2) - 1 + petabold(n) = pttabold(n) + old_gr % nb(2) - 1 + snew(n) = snew(n) + dsnew(n)/2. + sold(n) = sold(n) + dsold(n)/2. + endif +! + case('z') +! + pttabnew(n) = root % point(n) + pttabold(n) = root % point(n) + snew(n) = new_gr % Agrif_x(3) + sold(n) = old_gr % Agrif_x(3) + dsnew(n) = new_gr % Agrif_dx(3) + dsold(n) = old_gr % Agrif_dx(3) +! + if (root % posvar(n) == 1) then + petabnew(n) = pttabnew(n) + new_gr % nb(3) + petabold(n) = pttabold(n) + old_gr % nb(3) + else + petabnew(n) = pttabnew(n) + new_gr % nb(3) - 1 + petabold(n) = pttabold(n) + old_gr % nb(3) - 1 + snew(n) = snew(n) + dsnew(n)/2. + sold(n) = sold(n) + dsold(n)/2. + endif +! + case('N') +! + call Agrif_get_var_bounds(new_var,pttabnew(n),petabnew(n),n) +! + pttabold(n) = pttabnew(n) + petabold(n) = petabnew(n) + snew(n) = 0. + sold(n) = 0. + dsnew(n) = 1. + dsold(n) = 1. +! + end select +! + enddo +! + do n = 1,nbdim + nbtabnew(n) = petabnew(n) - pttabnew(n) + nbtabold(n) = petabold(n) - pttabold(n) + enddo +! + eps = min(minval(dsnew(1:nbdim)),minval(dsold(1:nbdim))) / 100. +! + do n = 1,nbdim + if (snew(n) > (sold(n)+dsold(n)*nbtabold(n)+eps)) return + if ((snew(n)+dsnew(n)*nbtabnew(n)-eps) < sold(n)) return + enddo +! + call Agrif_CopynD(new_var,old_var,pttabold,petabold,pttabnew,petabnew, & + sold,snew,dsold,dsnew,nbdim) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Copy +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_CopynD +! +!> Copy from the nD variable Old_Var the nD variable New_Var +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_CopynD ( new_var, old_var, pttabold, petabold, pttabnew, petabnew, & + sold, snew, dsold, dsnew, nbdim ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Variable), pointer, intent(inout) :: new_var + type(Agrif_Variable), pointer, intent(in) :: old_var + integer, dimension(nbdim), intent(in) :: pttabnew + integer, dimension(nbdim), intent(in) :: petabnew + integer, dimension(nbdim), intent(in) :: pttabold + integer, dimension(nbdim), intent(in) :: petabold + real, dimension(nbdim), intent(in) :: snew, sold + real, dimension(nbdim), intent(in) :: dsnew,dsold + integer, intent(in) :: nbdim +! + integer :: i,j,k,l,m,n,i0,j0,k0,l0,m0,n0 +! + real, dimension(nbdim) :: dim_gmin, dim_gmax + real, dimension(nbdim) :: dim_newmin, dim_newmax + real, dimension(nbdim) :: dim_min + integer, dimension(nbdim) :: ind_gmin,ind_newmin, ind_newmax +! + do i = 1,nbdim +! + dim_gmin(i) = sold(i) + dim_gmax(i) = sold(i) + (petabold(i)-pttabold(i)) * dsold(i) +! + dim_newmin(i) = snew(i) + dim_newmax(i) = snew(i) + (petabnew(i)-pttabnew(i)) * dsnew(i) +! + enddo +! + do i = 1,nbdim + if (dim_gmax(i) < dim_newmin(i)) return + if (dim_gmin(i) > dim_newmax(i)) return + enddo +! + do i = 1,nbdim +! + ind_newmin(i) = pttabnew(i) - floor(-(max(dim_gmin(i),dim_newmin(i))-dim_newmin(i))/dsnew(i)) + dim_min(i) = snew(i) + (ind_newmin(i)-pttabnew(i))*dsnew(i) + ind_gmin(i) = pttabold(i) + nint((dim_min(i)-dim_gmin(i))/dsold(i)) + ind_newmax(i) = pttabnew(i) + int((min(dim_gmax(i),dim_newmax(i))-dim_newmin(i))/dsnew(i)) +! + enddo +! + select case (nbdim) +! + case (1) + i0 = ind_gmin(1) + do i = ind_newmin(1),ind_newmax(1) + new_var % array1(i) = old_var % array1(i0) + new_var % restore1D(i) = 1 + i0 = i0 + int(dsnew(1)/dsold(1)) + enddo +! + case (2) + i0 = ind_gmin(1) ; do i = ind_newmin(1),ind_newmax(1) + j0 = ind_gmin(2) ; do j = ind_newmin(2),ind_newmax(2) + new_var % array2(i,j) = old_var % array2(i0,j0) + new_var % restore2D(i,j) = 1 + j0 = j0 + int(dsnew(2)/dsold(2)) + enddo + i0 = i0 + int(dsnew(1)/dsold(1)) + enddo +! + case (3) + i0 = ind_gmin(1) ; do i = ind_newmin(1),ind_newmax(1) + j0 = ind_gmin(2) ; do j = ind_newmin(2),ind_newmax(2) + k0 = ind_gmin(3) ; do k = ind_newmin(3),ind_newmax(3) + new_var % array3(i,j,k) = old_var % array3(i0,j0,k0) + new_var % restore3D(i,j,k) = 1 + k0 = k0 + int(dsnew(3)/dsold(3)) + enddo + j0 = j0 + int(dsnew(2)/dsold(2)) + enddo + i0 = i0 + int(dsnew(1)/dsold(1)) + enddo +! + case (4) + i0 = ind_gmin(1) ; do i = ind_newmin(1),ind_newmax(1) + j0 = ind_gmin(2) ; do j = ind_newmin(2),ind_newmax(2) + k0 = ind_gmin(3) ; do k = ind_newmin(3),ind_newmax(3) + l0 = ind_gmin(4) ; do l = ind_newmin(4),ind_newmax(4) + new_var % array4(i,j,k,l) = old_var % array4(i0,j0,k0,l0) + new_var % restore4D(i,j,k,l) = 1 + l0 = l0 + int(dsnew(4)/dsold(4)) + enddo + k0 = k0 + int(dsnew(3)/dsold(3)) + enddo + j0 = j0 + int(dsnew(2)/dsold(2)) + enddo + i0 = i0 + int(dsnew(1)/dsold(1)) + enddo +! + case (5) + i0 = ind_gmin(1) ; do i = ind_newmin(1),ind_newmax(1) + j0 = ind_gmin(2) ; do j = ind_newmin(2),ind_newmax(2) + k0 = ind_gmin(3) ; do k = ind_newmin(3),ind_newmax(3) + l0 = ind_gmin(4) ; do l = ind_newmin(4),ind_newmax(4) + m0 = ind_gmin(5) ; do m = ind_newmin(5),ind_newmax(5) + new_var % array5(i,j,k,l,m) = old_var % array5(i0,j0,k0,l0,m0) + new_var % restore5D(i,j,k,l,m) = 1 + m0 = m0 + int(dsnew(5)/dsold(5)) + enddo + l0 = l0 + int(dsnew(4)/dsold(4)) + enddo + k0 = k0 + int(dsnew(3)/dsold(3)) + enddo + j0 = j0 + int(dsnew(2)/dsold(2)) + enddo + i0 = i0 + int(dsnew(1)/dsold(1)) + enddo +! + case (6) + i0 = ind_gmin(1) ; do i = ind_newmin(1),ind_newmax(1) + j0 = ind_gmin(2) ; do j = ind_newmin(2),ind_newmax(2) + k0 = ind_gmin(3) ; do k = ind_newmin(3),ind_newmax(3) + l0 = ind_gmin(4) ; do l = ind_newmin(4),ind_newmax(4) + m0 = ind_gmin(5) ; do m = ind_newmin(5),ind_newmax(5) + n0 = ind_gmin(6) ; do n = ind_newmin(6),ind_newmax(6) + new_var % array6(i,j,k,l,m,n) = old_var % array6(i0,j0,k0,l0,m0,n0) + new_var % restore6D(i,j,k,l,m,n) = 1 + n0 = n0 + int(dsnew(6)/dsold(6)) + enddo + m0 = m0 + int(dsnew(5)/dsold(5)) + enddo + l0 = l0 + int(dsnew(4)/dsold(4)) + enddo + k0 = k0 + int(dsnew(3)/dsold(3)) + enddo + j0 = j0 + int(dsnew(2)/dsold(2)) + enddo + i0 = i0 + int(dsnew(1)/dsold(1)) + enddo +! + end select +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_CopynD +!=================================================================================================== +! +end module Agrif_Save diff --git a/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modseq.F90 b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modseq.F90 new file mode 100644 index 00000000..c1136067 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modseq.F90 @@ -0,0 +1,640 @@ +module Agrif_seq +! + use Agrif_Init + use Agrif_Procs + use Agrif_Arrays +! + implicit none +! +contains +! +#if defined AGRIF_MPI +!=================================================================================================== +function Agrif_seq_allocate_list ( nb_seqs ) result( seqlist ) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: nb_seqs +! + type(Agrif_Sequence_List), pointer :: seqlist +! + allocate(seqlist) + seqlist % nb_seqs = nb_seqs + allocate(seqlist % sequences(1:nb_seqs)) +!--------------------------------------------------------------------------------------------------- +end function Agrif_seq_allocate_list +!=================================================================================================== +! +!=================================================================================================== +subroutine Agrif_seq_add_grid ( seqlist, seq_num, grid ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Sequence_List), intent(inout) :: seqlist + integer, intent(in) :: seq_num + type(Agrif_Grid), pointer, intent(in) :: grid +! + call Agrif_gl_append(seqlist % sequences(seq_num) % gridlist, grid ) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_seq_add_grid +!=================================================================================================== +! +!=================================================================================================== +recursive subroutine Agrif_seq_init_sequences ( grid ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid), intent(inout) :: grid +! + type(Agrif_PGrid), pointer :: gp +! +#if defined AGRIF_MPI +! +! Build list of required procs for each child grid + gp => grid % child_list % first + do while ( associated( gp ) ) + call Agrif_seq_build_required_proclist( gp % gr ) + gp => gp % next + enddo +! +! Create integration sequences for the current grid + call Agrif_seq_create_proc_sequences( grid ) + call Agrif_seq_allocate_procs_to_childs( grid ) +! +! Create new communicators for sequences + call Agrif_seq_create_communicators( grid ) +! +#endif +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_seq_init_sequences +!=================================================================================================== +! +!=================================================================================================== +subroutine Agrif_seq_build_required_proclist ( grid ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid), intent(inout) :: grid +! + type(Agrif_Grid), pointer :: parent_grid + type(Agrif_Rectangle), pointer :: grid_rect + type(Agrif_Proc_p), pointer :: proc_rect + type(Agrif_Proc), pointer :: proc + logical :: proc_is_required + integer :: i +! + if ( grid % fixedrank == 0 ) then +! grid is the Root + if ( grid % required_proc_list % nitems == 0 ) then + print*, "### Error Agrif_seq_build_required_proclist: empty proc list." + print*, "# -> You should check if Agrif_Init_ProcList() is actually working." + stop + endif + return + endif +! + parent_grid => grid % parent + grid_rect => grid % rect_in_parent + proc_rect => parent_grid % proc_def_list % first +! + + do while ( associated( proc_rect ) ) + +! + proc => proc_rect % proc +! + proc_is_required = .true. + do i = 1,Agrif_Probdim + proc_is_required = ( proc_is_required .and. & + ( grid_rect % imin(i) <= proc % imax(i) ) .and. & + ( grid_rect % imax(i) >= proc % imin(i) ) ) + enddo +! + if ( proc_is_required ) then + call Agrif_pl_append(grid % required_proc_list, proc) + endif + proc_rect => proc_rect % next +! + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_seq_build_required_proclist +!=================================================================================================== +! +!=================================================================================================== +subroutine Agrif_seq_create_proc_sequences ( grid ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid), intent(inout) :: grid +! + type(Agrif_Grid_List), pointer :: sorted_child_list + type(Agrif_PGrid), pointer :: child_p + type(Agrif_PGrid), pointer :: g1p, g2p + type(Agrif_Proc_p), pointer :: pp1, pp2 + type(Agrif_Proc), pointer :: proc + integer :: nb_seq_max, nb_seqs, cur_seq +! + nb_seq_max = 0 +! + if ( grid % child_list % nitems == 0 ) return +! +! For each required proc... + pp1 => grid % required_proc_list % first + do while ( associated(pp1) ) + proc => pp1 % proc + proc % nb_seqs = 0 +! ..loop over all child grids... + child_p => grid % child_list % first + do while ( associated(child_p) ) +! ..and look for 'proc' in the list of procs required by 'child' + pp2 => child_p % gr % required_proc_list % first + do while ( associated(pp2) ) + if ( proc % pn == pp2 % proc % pn ) then +! 'proc' is required by this child grid, so we increment its number of sequences + proc % nb_seqs = proc % nb_seqs + 1 + pp2 => NULL() + else + pp2 => pp2 % next + endif + enddo + child_p => child_p % next + enddo + nb_seq_max = max(nb_seq_max, proc % nb_seqs) + pp1 => pp1 % next + enddo +! +! For each grid... + g1p => grid % child_list % first + do while ( associated(g1p) ) +! compare it with the following ones + g2p => g1p % next + do while ( associated(g2p) ) + if ( Agrif_seq_grids_are_connected( g1p % gr, g2p % gr ) ) then + call Agrif_gl_append( g1p % gr % neigh_list, g2p % gr ) + call Agrif_gl_append( g2p % gr % neigh_list, g1p % gr ) + endif + g2p => g2p % next + enddo + g1p => g1p % next + enddo +! +! Colorize graph nodes + nb_seqs = Agrif_seq_colorize_grid_list(grid % child_list) + sorted_child_list => Agrif_gl_merge_sort ( grid % child_list, compare_colors ) +! +! Create sequence structure + cur_seq = 0 + grid % child_seq => Agrif_seq_allocate_list(nb_seqs) + child_p => sorted_child_list % first + do while ( associated(child_p) ) + if ( cur_seq /= child_p % gr % seq_num ) then + cur_seq = child_p % gr % seq_num + endif + call Agrif_seq_add_grid(grid % child_seq,cur_seq,child_p% gr) + child_p => child_p % next + enddo +! + call Agrif_gl_delete(sorted_child_list) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_seq_create_proc_sequences +!=================================================================================================== +! +!=================================================================================================== +function Agrif_seq_grids_are_connected( g1, g2 ) result( connection ) +! +!< Compare required_proc_list for g1 and g2. These are connected if they share a same proc. +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid), intent(in) :: g1, g2 +! + logical :: connection + type(Agrif_Proc_p), pointer :: pp1, pp2 +! + connection = .false. +! + pp1 => g1 % required_proc_list % first +! + do while( associated(pp1) .and. (.not. connection) ) +! + pp2 => g2 % required_proc_list % first + do while ( associated(pp2) .and. (.not. connection) ) + if ( pp1 % proc % pn == pp2 % proc % pn ) then + ! if pp1 and pp2 are the same proc, it means that g1 and g2 are connected. We stop here. + connection = .true. + endif + pp2 => pp2 % next + enddo + pp1 => pp1 % next +! + enddo +!--------------------------------------------------------------------------------------------------- +end function Agrif_seq_grids_are_connected +!=================================================================================================== +! +!=================================================================================================== +function Agrif_seq_colorize_grid_list ( gridlist ) result ( ncolors ) +! +!< 1. Sort nodes in decreasing order of degree. +!< 2. Color the node with highest degree with color 1. +!< 3. Choose the node with the largest DSAT value. In case of conflict, choose the one with the +!! highest degree. Then the one corresponding to the largest grid. +!< 4. Color this node with the smallest possible color. +!< 5. If all nodes are colored, then stop. Otherwise, go to 3. +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid_List), intent(in) :: gridlist +! + type(Agrif_Grid_List), pointer :: X, Y + type(Agrif_PGrid), pointer :: gridp + type(Agrif_Grid_List), pointer :: tmp_gl + integer :: ncolors + integer, dimension(1:gridlist%nitems) :: colors +! +! Be carefull... + nullify(Y) +! +! First initialize the color of each node + gridp => gridlist % first + do while ( associated(gridp) ) + gridp % gr % seq_num = 0 + gridp => gridp % next + enddo +! +! Then sort the grids by decreasing degree + X => Agrif_gl_merge_sort( gridlist, compare_grid_degrees ) + gridp => X % first +! +! Colorize the first grid in the list + gridp % gr % seq_num = 1 + gridp => gridp % next +! +! Then for each of its neighbors... + do while ( associated(gridp) ) +! + if ( gridp % gr % neigh_list % nitems == 0 ) then + ! this grid is alone... let.s attach it to an existing sequence + call Agrif_seq_attach_grid( X, gridp % gr ) + gridp => gridp % next + cycle + endif +! +! Compute dsat value of all non-colored grids + tmp_gl => Agrif_gl_build_from_gp(gridp) + call Agrif_seq_calc_dsat(tmp_gl) +! +! Sort non-colored grids by decreasing dsat value, then by size + call Agrif_gl_delete(Y) + Y => Agrif_gl_merge_sort( tmp_gl, compare_dsat_values, compare_size_values ) +! +! Next coloration is for the first grid in this list TODO : maybe we could find a better choice ..? + gridp => Y % first +! +! Assign a color to the chosen grid + gridp % gr % seq_num = Agrif_seq_smallest_available_color_in_neighborhood( gridp % gr % neigh_list ) +! + gridp => gridp % next + call Agrif_gl_delete(tmp_gl) +! + enddo +! + call Agrif_gl_delete(X) + call Agrif_seq_colors_in_neighborhood( gridlist, colors ) + ncolors = maxval(colors) +!--------------------------------------------------------------------------------------------------- +end function Agrif_seq_colorize_grid_list +!=================================================================================================== +! +!=================================================================================================== +subroutine Agrif_seq_attach_grid ( gridlist, grid ) +! +!< 'grid' is not connected to any neighbor. Therefore, we give an existing and well chosen color. +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid_List), intent(in) :: gridlist + type(Agrif_Grid), intent(inout) :: grid +! + integer, dimension(gridlist%nitems) :: colors + integer, dimension(:), allocatable :: ngrids_by_color + integer :: i, color, ncolors +! + call Agrif_seq_colors_in_neighborhood( gridlist, colors ) + ncolors = maxval(colors) +! + allocate(ngrids_by_color(ncolors)) + ngrids_by_color = 0 +! + do i = 1,gridlist % nitems + if (colors(i) > 0) ngrids_by_color(colors(i)) = ngrids_by_color(colors(i)) + 1 + enddo +! + color = ncolors + do i = 1,ncolors + if ( ngrids_by_color(i) < color ) color = i + enddo +! + grid % seq_num = color + deallocate(ngrids_by_color) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_seq_attach_grid +!=================================================================================================== +! +!=================================================================================================== +subroutine Agrif_seq_colors_in_neighborhood ( neigh_list, colors ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid_List), intent(in) :: neigh_list + integer, dimension(:), intent(out) :: colors +! + integer :: i + type(Agrif_PGrid), pointer :: gridp +! + i = lbound(colors,1) + colors = 0 + gridp => neigh_list % first +! + do while ( associated(gridp) ) +! + if ( i > ubound(colors,1) ) then + print*,'Error in Agrif_seq_colors_in_neighborhood : "colors" array is too small' + stop + endif + colors(i) = gridp % gr % seq_num + gridp => gridp % next + i = i+1 +! + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_seq_colors_in_neighborhood +!=================================================================================================== +! +!=================================================================================================== +function Agrif_seq_smallest_available_color_in_neighborhood ( neigh_list ) result ( smallest ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid_List), intent(in) :: neigh_list +! + integer, dimension(:), allocatable :: color_is_met + integer :: colors_tab(1:neigh_list%nitems) + integer :: i, smallest, max_color +! + call Agrif_seq_colors_in_neighborhood( neigh_list, colors_tab ) + max_color = maxval(colors_tab) +! + allocate(color_is_met(1:max_color)) + color_is_met = 0 +! + do i = 1,neigh_list % nitems + if ( colors_tab(i) /= 0 ) then + color_is_met(colors_tab(i)) = 1 + endif + enddo +! + smallest = max_color+1 + do i = 1,max_color + if ( color_is_met(i) == 0 ) then + smallest = i + exit + endif + enddo +! + deallocate(color_is_met) +!--------------------------------------------------------------------------------------------------- +end function Agrif_seq_smallest_available_color_in_neighborhood +!=================================================================================================== +! +!=================================================================================================== +subroutine Agrif_seq_calc_dsat ( gridlist ) +!< For each node 'v' : +!< if none of its neighbors is colored then +!< DSAT(v) = degree(v) # degree(v) := number of neighbors +!< else +!< DSAT(v) = number of different colors used in the first neighborhood of v. +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid_List), intent(in) :: gridlist +! + type(Agrif_PGrid), pointer :: gridp + type(Agrif_Grid), pointer :: grid + integer, dimension(:), allocatable :: colors, color_is_met + integer :: i, ncolors +! + gridp => gridlist % first +! + do while ( associated(gridp) ) +! + grid => gridp % gr +! + allocate(colors(grid % neigh_list % nitems)) + call Agrif_seq_colors_in_neighborhood( grid % neigh_list, colors ) + + allocate(color_is_met(1:maxval(colors))) + color_is_met = 0 +! + do i = 1,grid % neigh_list % nitems + if ( colors(i) /= 0 ) then + color_is_met(colors(i)) = 1 + endif + enddo + ncolors = sum(color_is_met) +! + if ( ncolors == 0 ) then + grid % dsat = grid % neigh_list % nitems + else + grid % dsat = ncolors + endif + deallocate(colors, color_is_met) + gridp => gridp % next + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_seq_calc_dsat +!=================================================================================================== +! +!=================================================================================================== +subroutine Agrif_seq_allocate_procs_to_childs ( coarse_grid ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid), intent(inout) :: coarse_grid +! + integer :: is, ip, ig, ngrids + type(Agrif_Grid_List), pointer :: gridlist + type(Agrif_PGrid), pointer :: gp + type(Agrif_Grid), pointer :: grid + type(Agrif_Proc_List), pointer :: proclist + type(Agrif_Proc), pointer :: proc + type(Agrif_Proc_p), pointer :: pp + type(Agrif_Proc), dimension(:), allocatable, target :: procarray + type(Agrif_Grid), dimension(:), allocatable :: gridarray + type(Agrif_Sequence_List), pointer :: seqlist + real,dimension(:),allocatable :: grid_costs + integer,dimension(:), allocatable :: nbprocs_per_grid + integer :: i1, i2, j1, j2 + real :: max_cost + integer :: max_index +! + seqlist => coarse_grid % child_seq + if ( .not. associated(seqlist) ) return +! +! Initialize proc allocation + pp => coarse_grid % proc_def_list % first + do while ( associated(pp) ) + pp % proc % grid_id = 0 + pp => pp % next + enddo +! +! For each sequence... + do is = 1,seqlist % nb_seqs +! + proclist => seqlist % sequences(is) % proclist + gridlist => seqlist % sequences(is) % gridlist +! +! Copy coarse grid proc list and convert it to an array + call Agrif_pl_deep_copy( coarse_grid % proc_def_list, proclist ) + call Agrif_pl_to_array ( proclist, procarray ) +! +! Allocate a temporary array with concerned grid numbers + ngrids = gridlist % nitems + allocate(gridarray(1:ngrids)) + allocate(grid_costs(1:ngrids)) + allocate(nbprocs_per_grid(1:ngrids)) + + nbprocs_per_grid = 0 +! +! Allocate required procs to each grid + gp => gridlist % first + ig = 0 + do while ( associated(gp) ) + grid => gp % gr + ig = ig+1 ; gridarray(ig) = grid + pp => grid % required_proc_list % first + do while ( associated(pp) ) + procarray( pp % proc % pn+1 ) % grid_id = grid % fixedrank + nbprocs_per_grid(ig) = nbprocs_per_grid(ig) + 1 + pp => pp % next + enddo + gp => gp % next + enddo +! +! Add unused procs to the grids +! TODO FIXME: This is just a dummy allocation. You should take into account grid size and more +! information here... + +! Estimate current costs + + do ig = 1, ngrids + i1 = gridarray(ig)%ix(1) + i2 = gridarray(ig)%ix(1)+gridarray(ig)%nb(1)/gridarray(ig)%spaceref(1)-1 + j1 = gridarray(ig)%ix(2) + j2 = gridarray(ig)%ix(2)+gridarray(ig)%nb(2)/gridarray(ig)%spaceref(2)-1 + Call Agrif_estimate_parallel_cost(i1,i2,j1,j2,nbprocs_per_grid(ig),grid_costs(ig)) + grid_costs(ig) = grid_costs(ig) * gridarray(ig)%timeref(1) + enddo + + ig = 1 + do ip = 1,proclist%nitems + if ( procarray( ip ) % grid_id == 0 ) then +! this proc is unused + max_cost = 0. + max_index = 1 + do ig = 1,ngrids + if (grid_costs(ig) > max_cost) then + max_cost = grid_costs(ig) + max_index = ig + endif + enddo + + ig = max_index + procarray( ip ) % grid_id = gridarray(ig) % fixedrank + + nbprocs_per_grid(ig) = nbprocs_per_grid(ig) + 1 + i1 = gridarray(ig)%ix(1) + i2 = gridarray(ig)%ix(1)+gridarray(ig)%nb(1)/gridarray(ig)%spaceref(1)-1 + j1 = gridarray(ig)%ix(2) + j2 = gridarray(ig)%ix(2)+gridarray(ig)%nb(2)/gridarray(ig)%spaceref(2)-1 + Call Agrif_estimate_parallel_cost(i1,i2,j1,j2,nbprocs_per_grid(ig),grid_costs(ig)) + grid_costs(ig) = grid_costs(ig) * gridarray(ig)%timeref(1) + + endif + enddo +! +! Allocate proc nums to each grid + gp => gridlist % first + do while ( associated(gp) ) + do ip = 1,proclist%nitems + if ( procarray( ip ) % grid_id == gp % gr % fixedrank ) then + allocate(proc) + proc = procarray( ip ) + call Agrif_pl_append(gp % gr % proc_def_in_parent_list, proc) + endif + enddo + gp => gp % next + enddo +! +! Clean up + deallocate(procarray, gridarray, grid_costs, nbprocs_per_grid) +! + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_seq_allocate_procs_to_childs +!=================================================================================================== +! +!=================================================================================================== +subroutine Agrif_seq_create_communicators ( grid ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid), intent(inout) :: grid +! + include 'mpif.h' + type(Agrif_Sequence_List), pointer :: seqlist ! List of child sequences + type(Agrif_PGrid), pointer :: gridp + type(Agrif_Proc), pointer :: proc + integer :: i, ierr + integer :: current_comm, comm_seq, color_seq +! + seqlist => grid % child_seq + if ( .not. associated(seqlist) ) return +! + current_comm = grid % communicator + color_seq = MPI_COMM_NULL +! +! For each sequence, split the current communicator into as many groups as needed. + do i = 1,seqlist % nb_seqs +! +! Loop over each proclist to give a color to the current process + gridp => seqlist % sequences(i) % gridlist % first + grid_loop : do while ( associated(gridp) ) + proc => Agrif_pl_search_proc( gridp % gr % proc_def_in_parent_list, Agrif_Procrank ) + if ( associated(proc) ) then + if ( gridp % gr % fixedrank /= proc % grid_id ) then + write(*,'("### Error Agrif_seq_create_communicators : ")') + write(*,'(" inconsitancy on proc ",i2,":")') Agrif_Procrank + write(*,'("gr % fixedrank = ",i0,", where proc % grid_id = ",i0)') & + gridp % gr % fixedrank, proc % grid_id + stop + endif + color_seq = gridp % gr % fixedrank + exit grid_loop + endif + gridp => gridp % next + enddo grid_loop +! + call MPI_COMM_SPLIT(current_comm, color_seq, Agrif_ProcRank, comm_seq, ierr) + gridp % gr % communicator = comm_seq +! + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_seq_create_communicators +!=================================================================================================== +! +!=================================================================================================== +function Agrif_seq_select_child ( g, is ) result ( gridp ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid), pointer, intent(in) :: g + integer, intent(in) :: is +! + type(Agrif_PGrid), pointer :: gridp + type(Agrif_Proc), pointer :: proc +! + call Agrif_Instance( g ) + gridp => g % child_seq % sequences(is) % gridlist % first +! + do while ( associated(gridp) ) + proc => Agrif_pl_search_proc( gridp % gr % proc_def_in_parent_list, Agrif_Procrank ) + if ( associated(proc) ) then + return + endif + gridp => gridp % next + enddo + write(*,'("### Error Agrif_seq_select_child : no grid found in sequence ",i0," (mother G",i0,") for P",i0)')& + is, g%fixedrank, Agrif_Procrank + stop +!--------------------------------------------------------------------------------------------------- +end function Agrif_seq_select_child +!=================================================================================================== +#else + subroutine dummy_Agrif_seq () + end subroutine dummy_Agrif_seq +#endif +! +end module Agrif_seq diff --git a/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modtypes.F90 b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modtypes.F90 new file mode 100644 index 00000000..75489c87 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modtypes.F90 @@ -0,0 +1,452 @@ +! Agrif (Adaptive Grid Refinement In Fortran) +! +! Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr) +! Christophe Vouland (Christophe.Vouland@imag.fr) +! +! This program is free software; you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation; either version 2 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program; if not, write to the Free Software +! Foundation, Inc., 59 Temple Place-Suite 330, Boston, MA 02111-1307, USA. +! +! +! +! +!> Definition of data types used in AGRIF, of several variables and parameters +! +module Agrif_Types +! +use Agrif_Procs +! +implicit none +! +integer, parameter :: Agrif_MaxRaff = 7 !< Maximum refinement ratio +integer, parameter :: Agrif_NbMaxGrids = 10 !< Maximum number of grids of the hierarchy +! +!=================================================================================================== +type Agrif_LRectangle +!--------------------------------------------------------------------------------------------------- +!< Data type allowing a grid to reach a grid on the same level or its child grids +! + type(Agrif_Rectangle) , pointer :: r => NULL() !< to reach a child grid + type(Agrif_LRectangle), pointer :: next => NULL() !< to reach a grid on the same level +! +!--------------------------------------------------------------------------------------------------- +end type Agrif_LRectangle +!=================================================================================================== +! +!=================================================================================================== +type Agrif_Rectangle +!--------------------------------------------------------------------------------------------------- +!< Data type to define several characteristics of a grid (number, position, time and space +!< refinement factors, etc). +! + integer :: number !< Number of the grid + integer, dimension(3) :: imin !< Minimal position in the x,y and z direction + integer, dimension(3) :: imax !< Maximal position in the x,y and z direction + integer, dimension(3) :: spaceref !< Space refinement factor in the x,y and z direction + integer, dimension(3) :: timeref !< Time refinement factor in the x,y and z direction + type(Agrif_LRectangle), pointer :: childgrids => NULL() !< Pointer to reach a grid on the same level or a child grid +! +!--------------------------------------------------------------------------------------------------- +end type Agrif_Rectangle +!=================================================================================================== +! +!=================================================================================================== +type Agrif_Variable +!--------------------------------------------------------------------------------------------------- +!< Data type to characterize a grid variable. +! + type(Agrif_Variable), pointer :: root_var => NULL() !< pointer on the variable of the root grid + type(Agrif_Variable), pointer :: parent_var => NULL() !< pointer on the parent variable +! + integer, dimension(6) :: point !< index of the first point in the + !< real domain (x,y and z direction) + integer, dimension(:), allocatable :: posvar !< position of the variable on the cell + !< (1 for the boarder of the edge, 2 for the center) + integer :: interpIndex = -1 !< Indication for the space interpolation (module Agrif_Boundary) + integer :: nbdim = 0 !< number of dimensions of the grid variable + character(1), dimension(:), allocatable :: interptab !< Array indicating the type of dimension (space or not) + !! for each of them + integer, dimension(:), allocatable :: coords !< Array indicating the coordinate for each dimension + !! of the array that is refined : + !! 'x' -> 1 ; 'y' -> 2 ; 'z' -> 3 ; 'N' -> 0 + +!> @} +!> \name Arrays containing the values of the grid variables (real) +!> @{ + real, dimension(:) , allocatable :: array1 + real, dimension(:,:) , allocatable :: array2 + real, dimension(:,:,:) , allocatable :: array3 + real, dimension(:,:,:,:) , allocatable :: array4 + real, dimension(:,:,:,:,:) , allocatable :: array5 + real, dimension(:,:,:,:,:,:), allocatable :: array6 +!> @} +!> \name Arrays containing the values of the grid variables (real*8) +!> @{ + real(8), dimension(:) , allocatable :: darray1 + real(8), dimension(:,:) , allocatable :: darray2 + real(8), dimension(:,:,:) , allocatable :: darray3 + real(8), dimension(:,:,:,:) , allocatable :: darray4 + real(8), dimension(:,:,:,:,:) , allocatable :: darray5 + real(8), dimension(:,:,:,:,:,:), allocatable :: darray6 +!> @} +!> \name Arrays containing the values of the grid variables (real*4) +!> @{ + real(4), dimension(:) , allocatable :: sarray1 + real(4), dimension(:,:) , allocatable :: sarray2 + real(4), dimension(:,:,:) , allocatable :: sarray3 + real(4), dimension(:,:,:,:) , allocatable :: sarray4 + real(4), dimension(:,:,:,:,:) , allocatable :: sarray5 + real(4), dimension(:,:,:,:,:,:), allocatable :: sarray6 +!> @} +!> \name Arrays containing the values of the grid variables (real) +!> @{ + real, dimension(:) , pointer :: parray1 + real, dimension(:,:) , pointer :: parray2 + real, dimension(:,:,:) , pointer :: parray3 + real, dimension(:,:,:,:) , pointer :: parray4 + real, dimension(:,:,:,:,:) , pointer :: parray5 + real, dimension(:,:,:,:,:,:), pointer :: parray6 +!> @} +!> \name Arrays containing the values of the grid variables (real*8) +!> @{ + real(8), dimension(:) , pointer :: pdarray1 + real(8), dimension(:,:) , pointer :: pdarray2 + real(8), dimension(:,:,:) , pointer :: pdarray3 + real(8), dimension(:,:,:,:) , pointer :: pdarray4 + real(8), dimension(:,:,:,:,:) , pointer :: pdarray5 + real(8), dimension(:,:,:,:,:,:), pointer :: pdarray6 +!> @} +!> \name Arrays containing the values of the grid variables (real*4) +!> @{ + real(4), dimension(:) , pointer :: psarray1 + real(4), dimension(:,:) , pointer :: psarray2 + real(4), dimension(:,:,:) , pointer :: psarray3 + real(4), dimension(:,:,:,:) , pointer :: psarray4 + real(4), dimension(:,:,:,:,:) , pointer :: psarray5 + real(4), dimension(:,:,:,:,:,:), pointer :: psarray6 +!> @} +!> \name Arrays used to restore the values +!> @{ + integer, dimension(:) , pointer :: restore1D => NULL() + integer, dimension(:,:) , pointer :: restore2D => NULL() + integer, dimension(:,:,:) , pointer :: restore3D => NULL() + integer, dimension(:,:,:,:) , pointer :: restore4D => NULL() + integer, dimension(:,:,:,:,:) , pointer :: restore5D => NULL() + integer, dimension(:,:,:,:,:,:), pointer :: restore6D => NULL() +!> @} + + real, dimension(:,:), pointer :: oldvalues2D => NULL() !< Array used for the time interpolation + + logical :: restore = .FALSE. !< =1 if the variable should be restored + logical :: Interpolationshouldbemade = .FALSE. !< TRUE if the interpolation should be made in any case + integer :: bcinf !< option bc + integer :: bcsup !< option bc + integer, dimension(6) :: type_interp !< option interp + integer, dimension(6,6) :: type_interp_bc !< option bcinterp + integer, dimension(6) :: type_update !< option update + + integer, dimension(6) :: lb + integer, dimension(6) :: ub + + logical,dimension(6,2) :: memberin + integer,dimension(6,2,2,6,2) :: childarray + + type(Agrif_List_Interp_Loc), pointer :: list_interp => NULL() + type(Agrif_List_Interp_Loc), pointer :: list_update => NULL() +!--------------------------------------------------------------------------------------------------- +end type Agrif_Variable +!=================================================================================================== +! +!=================================================================================================== +type Agrif_Variable_c +!--------------------------------------------------------------------------------------------------- +!< Data type to characterize a grid variable. +! + type(Agrif_Variable_c), pointer :: root_var => NULL() !< pointer on the variable of the root grid + type(Agrif_Variable_c), pointer :: parent_var => NULL() !< pointer on the parent variable +! + integer :: nbdim = 0 !< number of dimensions of the grid variable +! +!> \name Arrays containing the values of the grid variables (character) +!> @{ + character(10000) :: carray0 + character(500), dimension(:) , allocatable :: carray1 + character(500), dimension(:,:), allocatable :: carray2 +!> @} +!--------------------------------------------------------------------------------------------------- +end type Agrif_Variable_c +!=================================================================================================== +! +!=================================================================================================== +type Agrif_Variable_r +!--------------------------------------------------------------------------------------------------- +!< Data type to characterize a grid variable. +! + type(Agrif_Variable_r), pointer :: root_var => NULL() !< pointer on the variable of the root grid + type(Agrif_Variable_r), pointer :: parent_var => NULL() !< pointer on the parent variable +! + integer :: nbdim = 0 !< number of dimensions of the grid variable +! +!> \name Arrays containing the values of the grid variables (real) +!> @{ + real :: array0 + real, dimension(:) , allocatable :: array1 + real, dimension(:,:) , allocatable :: array2 + real, dimension(:,:,:) , allocatable :: array3 + real, dimension(:,:,:,:) , allocatable :: array4 + real, dimension(:,:,:,:,:) , allocatable :: array5 + real, dimension(:,:,:,:,:,:), allocatable :: array6 +!> @} +!> \name Arrays containing the values of the grid variables (real*8) +!> @{ + real(8) :: darray0 + real(8), dimension(:) , allocatable :: darray1 + real(8), dimension(:,:) , allocatable :: darray2 + real(8), dimension(:,:,:) , allocatable :: darray3 + real(8), dimension(:,:,:,:) , allocatable :: darray4 + real(8), dimension(:,:,:,:,:) , allocatable :: darray5 + real(8), dimension(:,:,:,:,:,:), allocatable :: darray6 +!> @} +!> \name Arrays containing the values of the grid variables (real*4) +!> @{ + real(4) :: sarray0 + real(4), dimension(:) , allocatable :: sarray1 + real(4), dimension(:,:) , allocatable :: sarray2 + real(4), dimension(:,:,:) , allocatable :: sarray3 + real(4), dimension(:,:,:,:) , allocatable :: sarray4 + real(4), dimension(:,:,:,:,:) , allocatable :: sarray5 + real(4), dimension(:,:,:,:,:,:), allocatable :: sarray6 +!> @} +!--------------------------------------------------------------------------------------------------- +end type Agrif_Variable_r +!=================================================================================================== +!=================================================================================================== +! +!=================================================================================================== +type Agrif_Variable_l +!--------------------------------------------------------------------------------------------------- +!< Data type to characterize a grid variable. +! + type(Agrif_Variable_l), pointer :: root_var => NULL() !< pointer on the variable of the root grid + type(Agrif_Variable_l), pointer :: parent_var => NULL() !< pointer on the parent variable +! + integer :: nbdim = 0 !< number of dimensions of the grid variable +! +!> \name Arrays containing the values of the grid variables (logical) +!> @{ + logical :: larray0 = .FALSE. + logical, dimension(:) , allocatable :: larray1 + logical, dimension(:,:) , allocatable :: larray2 + logical, dimension(:,:,:) , allocatable :: larray3 + logical, dimension(:,:,:,:) , allocatable :: larray4 + logical, dimension(:,:,:,:,:) , allocatable :: larray5 + logical, dimension(:,:,:,:,:,:), allocatable :: larray6 +!> @} +!--------------------------------------------------------------------------------------------------- +end type Agrif_Variable_l +!=================================================================================================== +! +!=================================================================================================== +type Agrif_Variable_i +!--------------------------------------------------------------------------------------------------- +!< Data type to characterize a grid variable. +! + type(Agrif_Variable_i), pointer :: root_var => NULL() !< pointer on the variable of the root grid + type(Agrif_Variable_i), pointer :: parent_var => NULL() !< pointer on the parent variable +! + integer :: nbdim = 0 !< number of dimensions of the grid variable +! +!> \name Arrays containing the values of the grid variables (integer) +!> @{ + integer :: iarray0 = 0 + integer, dimension(:) , allocatable :: iarray1 + integer, dimension(:,:) , allocatable :: iarray2 + integer, dimension(:,:,:) , allocatable :: iarray3 + integer, dimension(:,:,:,:) , allocatable :: iarray4 + integer, dimension(:,:,:,:,:) , allocatable :: iarray5 + integer, dimension(:,:,:,:,:,:), allocatable :: iarray6 +!> @} +!--------------------------------------------------------------------------------------------------- +end type Agrif_Variable_i +!=================================================================================================== +! +!=================================================================================================== +type Agrif_Interp_Loc +!--------------------------------------------------------------------------------------------------- + integer,dimension(6) :: pttab, petab, pttab_Child, pttab_Parent = -99 + integer,dimension(6) :: indmin, indmax + integer,dimension(6) :: pttruetab,cetruetab + logical :: member, memberin +#if !defined AGRIF_MPI + integer,dimension(6) :: indminglob,indmaxglob +#else + integer,dimension(6) :: indminglob2,indmaxglob2 + integer,dimension(6,2,2) :: parentarray + integer,dimension(:,:,:), pointer :: tab4t => NULL() + integer,dimension(:,:,:), pointer :: tab5t => NULL() + logical, dimension(:), pointer :: memberinall => NULL() + logical, dimension(:), pointer :: memberinall2 => NULL() + logical, dimension(:), pointer :: sendtoproc1 => NULL() + logical, dimension(:), pointer :: sendtoproc2 => NULL() + logical, dimension(:), pointer :: recvfromproc1 => NULL() + logical, dimension(:), pointer :: recvfromproc2 => NULL() +#endif +!--------------------------------------------------------------------------------------------------- +end type Agrif_Interp_Loc +!=================================================================================================== + +!=================================================================================================== +type Agrif_List_Interp_Loc +!--------------------------------------------------------------------------------------------------- + type(Agrif_Interp_Loc), pointer :: interp_loc => NULL() + type(Agrif_List_Interp_Loc), pointer :: suiv => NULL() +!--------------------------------------------------------------------------------------------------- +end type Agrif_List_Interp_Loc +!=================================================================================================== + +!=================================================================================================== +type Agrif_Variables_List +!--------------------------------------------------------------------------------------------------- + type(Agrif_Variable), pointer :: var => NULL() + type(Agrif_Variables_List), pointer :: next => NULL() +!--------------------------------------------------------------------------------------------------- +end type Agrif_Variables_List +!=================================================================================================== +! +!=================================================================================================== +!> Different parameters +! + type(Agrif_Variable), dimension(:), pointer :: Agrif_tabvars => NULL() + type(Agrif_Variable_c), dimension(:), pointer :: Agrif_tabvars_c => NULL() + type(Agrif_Variable_r), dimension(:), pointer :: Agrif_tabvars_r => NULL() + type(Agrif_Variable_l), dimension(:), pointer :: Agrif_tabvars_l => NULL() + type(Agrif_Variable_i), dimension(:), pointer :: Agrif_tabvars_i => NULL() +! + integer :: Agrif_Probdim !< Problem dimension + integer,dimension(0:4):: Agrif_NbVariables !< Number of variables + integer :: Agrif_nbfixedgrids !< Number of fixed grids in the grid hierarchy + integer, dimension(3) :: Agrif_coeffref !< Space refinement factor + integer, dimension(3) :: Agrif_coeffreft !< Time refinement factor + logical :: Agrif_UseSpecialValue !< T if use special values on the parent grid + logical :: Agrif_UseSpecialValueInUpdate !< T if use special values on the parent grid + logical :: Agrif_Update_Weights = .FALSE. + logical :: Agrif_UseSpecialValueFineGrid !< T if use special values on the current grid + real :: Agrif_SpecialValue !< Special value on the parent grid + real :: Agrif_SpecialValueFineGrid !< Special value on the current grid +!> +!> \name Clustering parameters +!> @{ + integer :: Agrif_Regridding = 10 + integer :: Agrif_Minwidth + real :: Agrif_Efficiency = 0.7 + integer :: MaxSearch = 5 + real, dimension(3) :: Agrif_mind +!> @} +!> \name parameters for the interpolation of the child grids +!> @{ + integer, parameter :: Agrif_linear = 1 !< linear interpolation + integer, parameter :: Agrif_lagrange = 2 !< lagrange interpolation + integer, parameter :: Agrif_eno = 3 !< spline interpolation + integer, parameter :: Agrif_user_interp = 4 !< user defined interpolation + integer, parameter :: Agrif_constant = 5 !< constant interpolation + integer, parameter :: Agrif_linearconserv = 6 !< linear conservative interpolation + integer, parameter :: Agrif_linearconservlim = 7 !< linear conservative interpolation + integer, parameter :: Agrif_ppm = 8 !< PPM interpolation + integer, parameter :: Agrif_weno = 9 !< WENO5 interpolation + integer, parameter :: Agrif_ppm_lim = 10 !< PPM interpolation with monotonicity +!> @} +!> \name parameters for the update of the parent grids +!> @{ + integer, parameter :: Agrif_Update_Copy = 1 !< copy + integer, parameter :: Agrif_Update_Average = 2 !< average + integer, parameter :: Agrif_Update_Full_Weighting = 3 !< full-weighting +!> @} +!> \name Raffinement grid switches +!> @{ + integer :: Agrif_USE_ONLY_FIXED_GRIDS !< = 1 if fixed grid mode + integer :: Agrif_USE_FIXED_GRIDS !< = 1 if AMR mode + fixed grid else only AMR mode +!> @} + integer :: Agrif_Maxlevelloc +! +#if defined AGRIF_MPI + integer :: Agrif_Nbprocs !< Number of processors + integer :: Agrif_ProcRank !< Rank of the current processor + integer :: Agrif_Group !< Group associated to Agrif_mpi_comm + integer :: Agrif_mpi_comm +#else + integer :: Agrif_ProcRank = 0 +#endif +! + integer :: Agrif_Extra_Boundary_Cells = 3 !< When computing integration sequences, the grid rects + !! are expanded to this number of cells. + logical :: Agrif_Parallel_sisters = .FALSE. !< When TRUE, try to compute sister grids (which have the same parent) + !! in parallel rather than sequentially. + logical :: agrif_regrid_has_been_done = .FALSE. !< switch to skip Agrif_Regrid call +! + real, dimension(:) , allocatable :: parray1 + real, dimension(:,:) , allocatable :: parray2 + real, dimension(:,:,:) , allocatable :: parray3 + real, dimension(:,:,:,:) , allocatable :: parray4 + real, dimension(:,:,:,:,:) , allocatable :: parray5 + real, dimension(:,:,:,:,:,:), allocatable :: parray6 +! + logical :: agrif_debug = .false. ! may be activaded in users subroutine for debugging purposes + +! If a grand mother grid is present + logical :: agrif_coarse = .false. + integer, dimension(3) :: coarse_spaceref = (/1,1,1/) + integer, dimension(3) :: coarse_timeref = (/1,1,1/) +! +contains +! +!=================================================================================================== +! function Agrif_Ceiling +!--------------------------------------------------------------------------------------------------- +integer function Agrif_Ceiling ( x ) +!--------------------------------------------------------------------------------------------------- + real, intent(in) :: x +! + integer :: i +! + i = FLOOR(x) +! + if( ABS(x - i) <= 0.0001 )then + Agrif_Ceiling = i + else + Agrif_Ceiling = i+1 + endif +!--------------------------------------------------------------------------------------------------- +end function Agrif_Ceiling +!=================================================================================================== +! +!=================================================================================================== +! function Agrif_Int +!--------------------------------------------------------------------------------------------------- + integer function Agrif_Int(x) +!--------------------------------------------------------------------------------------------------- + real, intent(in) :: x +! + integer :: i +! + i = FLOOR(x) + 1 +! + if( ABS(x - i) <= 0.0001 )then + Agrif_Int = i + else + Agrif_Int = i-1 + endif +!--------------------------------------------------------------------------------------------------- +end function Agrif_Int +!=================================================================================================== +! +end module Agrif_Types diff --git a/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modupdate.F90 b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modupdate.F90 new file mode 100644 index 00000000..2f2fbdce --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modupdate.F90 @@ -0,0 +1,2132 @@ +! +! $Id: modupdate.F 779 2007-12-22 17:04:17Z rblod $ +! +! AGRIF (Adaptive Grid Refinement In Fortran) +! +! Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr) +! Christophe Vouland (Christophe.Vouland@imag.fr) +! +! This program is free software; you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation; either version 2 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program; if not, write to the Free Software +! Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA. +! +!> Module Agrif_Update +!> +!> This module contains procedures to update a parent grid from its child grids. +! +module Agrif_Update +! + use Agrif_UpdateBasic + use Agrif_Arrays + use Agrif_CurgridFunctions + use Agrif_Mask +#if defined AGRIF_MPI + use Agrif_Mpp +#endif +! + implicit none +! + logical, private :: precomputedone(7) = .FALSE. +! +contains +! +!=================================================================================================== +! subroutine Agrif_UpdateVariable +! +!> subroutine to set arguments for Agrif_UpdatenD +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_UpdateVariable ( parent, child, updateinf, updatesup, procname ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Variable), pointer :: parent !< Variable on the parent grid + type(Agrif_Variable), pointer :: child !< Variable on the child grid + integer, dimension(6), intent(in) :: updateinf !< First positions where interpolations are calculated + integer, dimension(6), intent(in) :: updatesup !< Last positions where interpolations are calculated + procedure() :: procname !< Data recovery procedure +!--------------------------------------------------------------------------------------------------- + integer, dimension(6) :: nb_child ! Number of cells on the child grid + integer, dimension(6) :: lb_child + integer, dimension(6) :: ub_child + integer, dimension(6) :: lb_parent + real , dimension(6) :: s_child ! Child grid position (s_root = 0) + real , dimension(6) :: s_parent ! Parent grid position (s_root = 0) + real , dimension(6) :: ds_child ! Child grid dx (ds_root = 1) + real , dimension(6) :: ds_parent ! Parent grid dx (ds_root = 1) + logical, dimension(6) :: do_update ! Indicates if we perform update for each dimension + integer, dimension(6) :: posvar ! Position of the variable on the cell (1 or 2) + integer, dimension(6) :: oldparentlbound, oldparentubound + integer :: n, nbdim + logical :: wholeupdate + type(Agrif_Variable), pointer :: root ! Variable on the root grid +! + root => child % root_var + nbdim = root % nbdim +! + call PreProcessToInterpOrUpdate( parent, child, & + nb_child, ub_child, & + lb_child, lb_parent, & + s_child, s_parent, & + ds_child, ds_parent, nbdim, interp=.false. ) +! + do_update(:) = .true. + posvar(1:nbdim) = root % posvar(1:nbdim) +! + do n = 1,nbdim +! + if ( root % interptab(n) == 'N' ) then + posvar(n) = 1 + do_update(n) = .false. + oldparentlbound(n) = parent % lb(n) + oldparentubound(n) = parent % ub(n) + parent % lb(n) = child % lb(n) + parent % ub(n) = child % ub(n) + end if +! + enddo + + wholeupdate = .FALSE. +! + do n = 1,nbdim + if ( do_update(n) ) then + if ( (updateinf(n) > updatesup(n)) .OR. & + ((updateinf(n) == -99) .AND. (updatesup(n) == -99)) & + ) then + wholeupdate = .TRUE. + endif + endif + enddo +! + IF (wholeupdate) THEN + call Agrif_UpdateWhole(parent, child, & + updateinf(1:nbdim), updatesup(1:nbdim), & + lb_child(1:nbdim), lb_parent(1:nbdim), & + nb_child(1:nbdim), posvar(1:nbdim), & + do_update(1:nbdim), & + s_child(1:nbdim), s_parent(1:nbdim), & + ds_child(1:nbdim), ds_parent(1:nbdim), nbdim, procname) + ELSE + call Agrif_UpdateBcnD(parent, child, & + updateinf(1:nbdim), updatesup(1:nbdim), & + lb_child(1:nbdim), lb_parent(1:nbdim), & + nb_child(1:nbdim), posvar(1:nbdim), & + do_update(1:nbdim), & + s_child(1:nbdim), s_parent(1:nbdim), & + ds_child(1:nbdim), ds_parent(1:nbdim), nbdim, procname) + ENDIF +! + do n = 1,nbdim +! + if ( root % interptab(n) == 'N' ) then ! No space DIMENSION + parent % lb(n) = oldparentlbound(n) + parent % ub(n) = oldparentubound(n) + end if +! + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_UpdateVariable +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_UpdateWhole +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_UpdateWhole ( parent, child, uinf, usup, & + lb_child, lb_parent, & + nb_child, posvar, & + do_update, & + s_child, s_parent, & + ds_child, ds_parent, nbdim, procname ) +!--------------------------------------------------------------------------------------------------- +#if defined AGRIF_MPI + include 'mpif.h' +#endif +! + type(Agrif_Variable), pointer :: parent !< Variable on the parent grid + type(Agrif_Variable), pointer :: child !< Variable on the child grid + integer, dimension(nbdim), intent(in) :: uinf !< First positions where interpolations are calculated + integer, dimension(nbdim), intent(in) :: usup !< Last positions where interpolations are calculated + integer, intent(in) :: nbdim !< Number of dimensions of the grid variable + integer, dimension(nbdim), intent(in) :: lb_child !< Index of the first point inside the domain for the parent grid variable + integer, dimension(nbdim), intent(in) :: lb_parent !< Index of the first point inside the domain for the child grid variable + integer, dimension(nbdim), intent(in) :: nb_child !< Number of cells of the child grid + integer, dimension(nbdim), intent(in) :: posvar !< Position of the variable on the cell (1 or 2) + logical, dimension(nbdim), intent(in) :: do_update !< Indicates if we update for each dimension + real, dimension(nbdim), intent(in) :: s_child !< Positions of the child grid + real, dimension(nbdim), intent(in) :: s_parent !< Positions of the parent grid + real, dimension(nbdim), intent(in) :: ds_child !< Space steps of the child grid + real, dimension(nbdim), intent(in) :: ds_parent !< Space steps of the parent grid + procedure() :: procname !< Data recovery procedure +! + integer, dimension(nbdim) :: type_update ! Type of update (copy or average) + integer, dimension(nbdim,2) :: lubglob + integer, dimension(nbdim,2,2) :: indtab ! limits of the child grid that will be used in the update scheme + integer, dimension(nbdim,2,2) :: indtruetab ! grid variable where boundary conditions are + integer :: coeffraf, i + integer :: uinfloc, usuploc +! + type_update = child % root_var % type_update(1:nbdim) +! + do i = 1, nbdim +! + if ( do_update(i) ) then +! + coeffraf = nint(ds_parent(i)/ds_child(i)) + uinfloc = 0 + usuploc = nb_child(i)/coeffraf - 1 + + IF (posvar(i) == 1) THEN + usuploc = usuploc - 1 + ENDIF + + IF (uinf(i) > usup(i)) THEN + uinfloc = uinf(i) + usuploc = usuploc - uinf(i) + ENDIF + + indtab(i,1,1) = lb_child(i) + (uinfloc + 1) * coeffraf + indtab(i,1,2) = lb_child(i) + (usuploc + 1) * coeffraf + + IF ( posvar(i) == 1 ) THEN + IF ( type_update(i) == Agrif_Update_Full_Weighting ) THEN + indtab(i,1,1) = indtab(i,1,1) - (coeffraf - 1) + indtab(i,1,2) = indtab(i,1,2) + (coeffraf - 1) + ELSE IF ( type_update(i) /= Agrif_Update_Copy ) THEN + indtab(i,1,1) = indtab(i,1,1) - coeffraf / 2 + indtab(i,1,2) = indtab(i,1,2) + coeffraf / 2 + ENDIF + ELSE + indtab(i,1,1) = indtab(i,1,1) - coeffraf + indtab(i,1,2) = indtab(i,1,2) - 1 + ! at this point, indices are OK for an average + IF ( type_update(i) == Agrif_Update_Full_Weighting ) THEN + indtab(i,1,1) = indtab(i,1,1) - coeffraf / 2 + indtab(i,1,2) = indtab(i,1,2) + coeffraf / 2 + ENDIF + ENDIF +! + else ! IF ( .not.do_update(i) ) THEN +! + if ( posvar(i) == 1 ) then + indtab(i,1,1) = lb_child(i) + indtab(i,1,2) = lb_child(i) + nb_child(i) + else + indtab(i,1,1) = lb_child(i) + indtab(i,1,2) = lb_child(i) + nb_child(i) - 1 + endif +! + endif + enddo + +! lubglob contains the global lbound and ubound of the child array +! lubglob(:,1) : global lbound for each dimension +! lubglob(:,2) : global lbound for each dimension +! + call Agrif_get_var_global_bounds(child, lubglob, nbdim) +! + indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1), lubglob(1:nbdim,1)) + indtruetab(1:nbdim,1,2) = min(indtab(1:nbdim,1,2), lubglob(1:nbdim,2)) +! + call Agrif_UpdatenD(type_update, parent, child, & + indtruetab(1:nbdim,1,1), indtruetab(1:nbdim,1,2), & + lb_child(1:nbdim), lb_parent(1:nbdim), & + s_child(1:nbdim), s_parent(1:nbdim), & + ds_child(1:nbdim), ds_parent(1:nbdim), & +#if defined AGRIF_MPI + posvar, do_update, & +#endif + nbdim, procname) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_UpdateWhole +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_UpdateBcnd +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_UpdateBcnd ( parent, child, uinf, usup, & + lb_child, lb_parent, & + nb_child, posvar, & + do_update, & + s_child, s_parent, & + ds_child, ds_parent, nbdim, procname ) +!--------------------------------------------------------------------------------------------------- +#if defined AGRIF_MPI + include 'mpif.h' +#endif +! + type(Agrif_Variable), pointer :: parent !< Variable on the parent grid + type(Agrif_Variable), pointer :: child !< Variable on the child grid + integer, dimension(nbdim), intent(in) :: uinf !< First positions where interpolations are calculated + integer, dimension(nbdim), intent(in) :: usup !< Last positions where interpolations are calculated + integer :: nbdim !< Number of dimensions of the grid variable + integer, dimension(nbdim), intent(in) :: lb_child !< Index of the first point inside the domain for + !! the parent grid variable + integer, dimension(nbdim), intent(in) :: lb_parent !< Index of the first point inside the domain for + !! the child grid variable + integer, dimension(nbdim), intent(in) :: nb_child !< Number of cells of the child grid + integer, dimension(nbdim), intent(in) :: posvar !< Position of the variable on the cell (1 or 2) + logical, dimension(nbdim), intent(in) :: do_update !< Indicates if we update for each dimension + real, dimension(nbdim), intent(in) :: s_child !< Positions of the child grid + real, dimension(nbdim), intent(in) :: s_parent !< Positions of the parent grid + real, dimension(nbdim), intent(in) :: ds_child !< Space steps of the child grid + real, dimension(nbdim), intent(in) :: ds_parent !< Space steps of the parent grid + procedure() :: procname !< Data recovery procedure +! + integer,dimension(nbdim) :: type_update ! Type of update (copy or average) + integer,dimension(nbdim,2) :: lubglob + integer :: i + integer,dimension(nbdim,2,2) :: indtab ! Arrays indicating the limits of the child + integer,dimension(nbdim,2,2) :: indtruetab ! grid variable where boundary conditions are + integer,dimension(nbdim,2,2,nbdim) :: ptres ! calculated + integer :: nb, ndir + integer :: coeffraf +! + type_update = child % root_var % type_update(1:nbdim) +! + DO i = 1, nbdim + coeffraf = nint(ds_parent(i)/ds_child(i)) + indtab(i,1,1) = lb_child(i) + (uinf(i) + 1) * coeffraf + indtab(i,1,2) = lb_child(i) + (usup(i) + 1) * coeffraf + + indtab(i,2,1) = lb_child(i) + nb_child(i) - (usup(i)+1) * coeffraf + indtab(i,2,2) = lb_child(i) + nb_child(i) - (uinf(i)+1) * coeffraf + + IF (posvar(i) == 1) THEN + IF (type_update(i) == Agrif_Update_Full_Weighting) THEN + indtab(i,:,1) = indtab(i,:,1) - (coeffraf - 1) + indtab(i,:,2) = indtab(i,:,2) + (coeffraf - 1) + ELSE IF (type_update(i) /= Agrif_Update_Copy) THEN + indtab(i,:,1) = indtab(i,:,1) - coeffraf / 2 + indtab(i,:,2) = indtab(i,:,2) + coeffraf / 2 + ENDIF + ELSE + indtab(i,1,1) = indtab(i,1,1) - coeffraf + indtab(i,1,2) = indtab(i,1,2) - 1 + indtab(i,2,2) = indtab(i,2,2) + coeffraf - 1 + IF (type_update(i) == Agrif_Update_Full_Weighting) THEN + indtab(i,1,1) = indtab(i,1,1) - coeffraf/2 + indtab(i,1,2) = indtab(i,1,2) + coeffraf/2 + indtab(i,2,1) = indtab(i,2,1) - coeffraf/2 + indtab(i,2,2) = indtab(i,2,2) + coeffraf/2 + ENDIF + ENDIF + ENDDO +! + call Agrif_get_var_global_bounds(child,lubglob,nbdim) +! + indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1),lubglob(1:nbdim,1)) + indtruetab(1:nbdim,1,2) = max(indtab(1:nbdim,1,2),lubglob(1:nbdim,1)) + indtruetab(1:nbdim,2,1) = min(indtab(1:nbdim,2,1),lubglob(1:nbdim,2)) + indtruetab(1:nbdim,2,2) = min(indtab(1:nbdim,2,2),lubglob(1:nbdim,2)) +! + do nb = 1,nbdim + if ( do_update(nb) ) then + do ndir = 1,2 + ptres(nb,1,ndir,nb) = indtruetab(nb,ndir,1) + ptres(nb,2,ndir,nb) = indtruetab(nb,ndir,2) + do i = 1,nbdim + if ( i /= nb ) then + if ( do_update(i) ) then + ptres(i,1,ndir,nb) = indtruetab(i,1,1) + ptres(i,2,ndir,nb) = indtruetab(i,2,2) + else + if (posvar(i) == 1) then + ptres(i,1,ndir,nb) = lb_child(i) + ptres(i,2,ndir,nb) = lb_child(i) + nb_child(i) + else + ptres(i,1,ndir,nb) = lb_child(i) + ptres(i,2,ndir,nb) = lb_child(i) + nb_child(i) - 1 + endif + endif + endif + enddo + enddo + endif + enddo +! + do nb = 1,nbdim + if ( do_update(nb) ) then + do ndir = 1,2 + call Agrif_UpdatenD(type_update, parent, child, & + ptres(1:nbdim,1,ndir,nb),ptres(1:nbdim,2,ndir,nb), & + lb_child(1:nbdim),lb_parent(1:nbdim), & + s_child(1:nbdim),s_parent(1:nbdim), & + ds_child(1:nbdim),ds_parent(1:nbdim), & +#if defined AGRIF_MPI + posvar,do_update, & +#endif + nbdim,procname,nb,ndir) + enddo + endif + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_UpdateBcnd +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_UpdatenD +! +!> updates a 2D grid variable on the parent grid of the current grid +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_UpdatenD ( type_update, parent, child, & + pttab, petab, & + lb_child, lb_parent, & + s_child, s_parent, & + ds_child, ds_parent, & +#if defined AGRIF_MPI + posvar, do_update, & +#endif + nbdim, procname, nb, ndir ) +!--------------------------------------------------------------------------------------------------- +#if defined AGRIF_MPI + include 'mpif.h' +#endif +! + type(Agrif_Variable), pointer :: parent !< Variable of the parent grid + type(Agrif_Variable), pointer :: child !< Variable of the child grid + integer, intent(in) :: nbdim + integer, dimension(nbdim), intent(in) :: type_update !< Type of update (copy or average) + integer, dimension(nbdim), intent(in) :: pttab !< Index of the first point inside the domain + integer, dimension(nbdim), intent(in) :: petab !< Index of the first point inside the domain + integer, dimension(nbdim), intent(in) :: lb_child !< Index of the first point inside the domain for the child + !! grid variable + integer, dimension(nbdim), intent(in) :: lb_parent !< Index of the first point inside the domain for the parent + !! grid variable + real, dimension(nbdim), intent(in) :: s_child !< Positions of the child grid + real, dimension(nbdim), intent(in) :: s_parent !< Positions of the parent grid + real, dimension(nbdim), intent(in) :: ds_child !< Space steps of the child grid + real, dimension(nbdim), intent(in) :: ds_parent !< Space steps of the parent grid + procedure() :: procname !< Data recovery procedure + integer, optional, intent(in) :: nb, ndir +!--------------------------------------------------------------------------------------------------- + integer, dimension(nbdim) :: pttruetab, cetruetab +#if defined AGRIF_MPI + integer, dimension(nbdim) :: posvar !< Position of the variable on the cell (1 or 2) + logical, dimension(nbdim) :: do_update +#endif + integer, dimension(nbdim) :: coords + integer, dimension(nbdim) :: indmin, indmax + integer, dimension(nbdim) :: indminglob, indmaxglob + real , dimension(nbdim) :: s_Child_temp, s_Parent_temp + integer, dimension(nbdim) :: lowerbound,upperbound + integer, dimension(nbdim) :: pttruetabwhole, cetruetabwhole + integer, dimension(nbdim,2,2) :: childarray + integer, dimension(nbdim,2,2) :: parentarray + integer,dimension(nbdim) :: type_update_temp + logical :: memberin, member + integer :: nbin, ndirin +! +#if defined AGRIF_MPI +! + integer,dimension(nbdim) :: indminglob2,indmaxglob2 + logical, dimension(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1 + logical, dimension(0:Agrif_Nbprocs-1) :: sendtoproc2,recvfromproc2 + integer :: code, local_proc + integer :: i,j,k + integer, dimension(nbdim,4) :: tab3 + integer, dimension(nbdim,4,0:Agrif_Nbprocs-1) :: tab4 + integer, dimension(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t + integer, dimension(nbdim,0:Agrif_Nbprocs-1,8) :: tab5t + logical :: find_list_update + logical, dimension(0:Agrif_Nbprocs-1) :: memberinall, memberinall2 + logical, dimension(1) :: memberin1 +! +#endif +! + type(Agrif_Variable), pointer, save :: tempC => NULL() ! Temporary child grid variable + type(Agrif_Variable), pointer, save :: tempP => NULL() ! Temporary parent grid variable + type(Agrif_Variable), pointer, save :: tempCextend => NULL() ! Temporary child + type(Agrif_Variable), pointer, save :: tempPextend => NULL() ! Temporary parent + type(Agrif_Variable), pointer :: tempP_indic, tempP_average + type(Agrif_Variable), pointer :: tempC_indic + logical :: compute_average + real :: coeff_multi + integer :: nb_dimensions +! +! Get local lower and upper bound of the child variable + call Agrif_get_var_bounds_array(child, lowerbound, upperbound, nbdim) + +! here pttab and petab corresponds to the (global) indices of the points needed in the update +! pttruetab and cetruetab contains only indices that are present on the local processor +! + coords = child % root_var % coords +! + call Agrif_Childbounds( nbdim, lowerbound, upperbound, pttab, petab, Agrif_Procrank, & + coords, pttruetab, cetruetab, memberin ) + call Agrif_Prtbounds( nbdim, indminglob, indmaxglob, s_Parent_temp, s_Child_temp, & + s_child, ds_child, s_parent, ds_parent, & + pttab, petab, lb_child, lb_parent & +#if defined AGRIF_MPI + , posvar, type_update, do_update, pttruetabwhole, cetruetabwhole & +#endif + ) + +#if defined AGRIF_MPI +! + IF (memberin) THEN + call Agrif_GlobalToLocalBounds(childarray,lowerbound,upperbound, & + pttruetab,cetruetab, coords, & + nbdim, Agrif_Procrank, member) + ENDIF + + call Agrif_Prtbounds(nbdim, indmin, indmax, & + s_Parent_temp, s_Child_temp, & + s_child, ds_child, s_parent, ds_parent, & + pttruetab, cetruetab, lb_child, lb_parent, & + posvar, type_update, do_update, & + pttruetabwhole, cetruetabwhole) +! +#else + indmin = indminglob + indmax = indmaxglob + pttruetabwhole = pttruetab + cetruetabwhole = cetruetab + childarray(:,1,2) = pttruetab + childarray(:,2,2) = cetruetab +#endif + + IF (.not.present(nb)) THEN + nbin=0 + ndirin=0 + ELSE + nbin = nb + ndirin = ndir + ENDIF + + IF (memberin) THEN +! + IF ( .not.associated(tempC) ) allocate(tempC) +! + call Agrif_array_allocate(tempC,pttruetab,cetruetab,nbdim) + call Agrif_var_set_array_tozero(tempC,nbdim) + + SELECT CASE (nbdim) + CASE(1) + CALL procname(tempC%array1, & + childarray(1,1,2),childarray(1,2,2),.TRUE.,nbin,ndirin) + CASE(2) + CALL procname(tempC%array2, & + childarray(1,1,2),childarray(1,2,2), & + childarray(2,1,2),childarray(2,2,2),.TRUE.,nbin,ndirin) + CASE(3) + CALL procname(tempC%array3, & + childarray(1,1,2),childarray(1,2,2), & + childarray(2,1,2),childarray(2,2,2), & + childarray(3,1,2),childarray(3,2,2),.TRUE.,nbin,ndirin) + CASE(4) + CALL procname(tempC%array4, & + childarray(1,1,2),childarray(1,2,2), & + childarray(2,1,2),childarray(2,2,2), & + childarray(3,1,2),childarray(3,2,2), & + childarray(4,1,2),childarray(4,2,2),.TRUE.,nbin,ndirin) + CASE(5) + CALL procname(tempC%array5, & + childarray(1,1,2),childarray(1,2,2), & + childarray(2,1,2),childarray(2,2,2), & + childarray(3,1,2),childarray(3,2,2), & + childarray(4,1,2),childarray(4,2,2), & + childarray(5,1,2),childarray(5,2,2),.TRUE.,nbin,ndirin) + CASE(6) + CALL procname(tempC%array6, & + childarray(1,1,2),childarray(1,2,2), & + childarray(2,1,2),childarray(2,2,2), & + childarray(3,1,2),childarray(3,2,2), & + childarray(4,1,2),childarray(4,2,2), & + childarray(5,1,2),childarray(5,2,2), & + childarray(6,1,2),childarray(6,2,2),.TRUE.,nbin,ndirin) + END SELECT +! + ENDIF +! +#if defined AGRIF_MPI +! +! tab2 contains the necessary limits of the parent grid for each processor + + if (Associated(child%list_update)) then + call Agrif_Find_list_update(child%list_update,pttab,petab, & + lb_child,lb_parent,nbdim, & + find_list_update,tab4t,tab5t,memberinall,memberinall2, & + sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2) + else + find_list_update = .FALSE. + endif + + if (.not.find_list_update) then + tab3(:,1) = pttruetab(:) + tab3(:,2) = cetruetab(:) + tab3(:,3) = pttruetabwhole(:) + tab3(:,4) = cetruetabwhole(:) +! + call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim,MPI_INTEGER,Agrif_mpi_comm,code) + + if ( .not.associated(tempCextend) ) allocate(tempCextend) + do k=0,Agrif_Nbprocs-1 + do j=1,4 + do i=1,nbdim + tab4t(i,k,j) = tab4(i,j,k) + enddo + enddo + enddo + + memberin1(1) = memberin + call MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall,1,MPI_LOGICAL,Agrif_mpi_comm,code) + + call Get_External_Data_first(tab4t(:,:,1),tab4t(:,:,2),tab4t(:,:,3),tab4t(:,:,4), & + nbdim, memberinall, coords, & + sendtoproc1,recvfromproc1, & + tab4t(:,:,5),tab4t(:,:,6),tab4t(:,:,7),tab4t(:,:,8), & + tab4t(:,:,1),tab4t(:,:,2)) + endif + + call ExchangeSameLevel(sendtoproc1,recvfromproc1,nbdim, & + tab4t(:,:,3),tab4t(:,:,4),tab4t(:,:,5),tab4t(:,:,6), & + tab4t(:,:,7),tab4t(:,:,8),memberin,tempC,tempCextend) + +#else + tempCextend => tempC +#endif +! +! Update of the parent grid (tempP) from the child grid (tempC) +! + IF (memberin) THEN +! + IF ( .not.associated(tempP) ) allocate(tempP) +! + call Agrif_array_allocate(tempP,indmin,indmax,nbdim) +! + if ( nbdim == 1 ) then + tempP % array1 = 0. + call Agrif_Update_1D_Recursive( type_update(1), & + tempP%array1, & + tempCextend%array1, & + indmin(1), indmax(1), & + pttruetabwhole(1), cetruetabwhole(1), & + s_Child_temp(1), s_Parent_temp(1), & + ds_child(1), ds_parent(1) ) + + IF (Agrif_UseSpecialValueInUpdate) THEN + allocate(tempC_indic) + allocate(tempP_indic) + call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array1),ubound(tempCextend%array1),nbdim) + call Agrif_array_allocate(tempP_indic,lbound(tempP%array1),ubound(tempP%array1),nbdim) + + compute_average = .FALSE. + type_update_temp(1:nbdim) = type_update(1:nbdim) + IF (ANY(type_update(1:nbdim) == Agrif_Update_Full_Weighting)) THEN + compute_average = .TRUE. + allocate(tempP_average) + call Agrif_array_allocate(tempP_average,lbound(tempP%array1),ubound(tempP%array1),nbdim) + WHERE (type_update(1:nbdim) == Agrif_Update_Full_Weighting) + type_update_temp(1:nbdim) = Agrif_Update_Average + END WHERE + call Agrif_Update_1D_Recursive( type_update_temp(1), & + tempP_average%array1, & + tempCextend%array1, & + indmin(1), indmax(1), & + pttruetabwhole(1), cetruetabwhole(1), & + s_Child_temp(1), s_Parent_temp(1), & + ds_child(1), ds_parent(1) ) + coeff_multi = 1. + do nb_dimensions=1,nbdim + coeff_multi = coeff_multi * nint(ds_parent(nb_dimensions)/ds_child(nb_dimensions)) + enddo + ENDIF + + WHERE (tempCextend%array1 == Agrif_SpecialValueFineGrid) + tempC_indic%array1 = 0. + ELSEWHERE + tempC_indic%array1 = 1. + END WHERE + + Agrif_UseSpecialValueInUpdate = .FALSE. + Agrif_Update_Weights = .TRUE. + + call Agrif_Update_1D_Recursive( type_update_temp(1), & + tempP_indic%array1, & + tempC_indic%array1, & + indmin(1), indmax(1), & + pttruetabwhole(1), cetruetabwhole(1), & + s_Child_temp(1), s_Parent_temp(1), & + ds_child(1), ds_parent(1) ) + + Agrif_UseSpecialValueInUpdate = .TRUE. + Agrif_Update_Weights = .FALSE. + + IF (compute_average) THEN + WHERE (tempP_indic%array1 == 0.) + tempP%array1 = Agrif_SpecialValueFineGrid + ELSEWHERE ((tempP_indic%array1 == coeff_multi).AND.(tempP%array1 /= Agrif_SpecialValueFineGrid)) + tempP%array1 = tempP%array1 /tempP_indic%array1 + ELSEWHERE + tempP%array1 = tempP_average%array1 /tempP_indic%array1 + END WHERE + + ELSE + WHERE (tempP_indic%array1 == 0.) + tempP%array1 = Agrif_SpecialValueFineGrid + ELSEWHERE + tempP%array1 = tempP%array1 /tempP_indic%array1 + END WHERE + ENDIF + + deallocate(tempP_indic%array1) + deallocate(tempC_indic%array1) + deallocate(tempC_indic) + deallocate(tempP_indic) + IF (compute_average) THEN + deallocate(tempP_average%array1) + deallocate(tempP_average) + ENDIF + ENDIF + + endif + if ( nbdim == 2 ) then + call Agrif_Update_2D_Recursive( type_update(1:2), & + tempP%array2, & + tempCextend%array2, & + indmin(1:2), indmax(1:2), & + pttruetabwhole(1:2), cetruetabwhole(1:2), & + s_Child_temp(1:2), s_Parent_temp(1:2), & + ds_child(1:2), ds_parent(1:2) ) + + IF (Agrif_UseSpecialValueInUpdate) THEN + allocate(tempC_indic) + allocate(tempP_indic) + call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array2),ubound(tempCextend%array2),nbdim) + call Agrif_array_allocate(tempP_indic,lbound(tempP%array2),ubound(tempP%array2),nbdim) + + compute_average = .FALSE. + type_update_temp(1:nbdim) = type_update(1:nbdim) + IF (ANY(type_update == Agrif_Update_Full_Weighting)) THEN + compute_average = .TRUE. + allocate(tempP_average) + call Agrif_array_allocate(tempP_average,lbound(tempP%array2),ubound(tempP%array2),nbdim) + WHERE (type_update(1:nbdim) == Agrif_Update_Full_Weighting) + type_update_temp(1:nbdim) = Agrif_Update_Average + END WHERE + call Agrif_Update_2D_Recursive( type_update_temp(1:2), & + tempP_average%array2, & + tempCextend%array2, & + indmin(1:2), indmax(1:2), & + pttruetabwhole(1:2), cetruetabwhole(1:2), & + s_Child_temp(1:2), s_Parent_temp(1:2), & + ds_child(1:2), ds_parent(1:2) ) + coeff_multi = 1. + do nb_dimensions=1,nbdim + coeff_multi = coeff_multi * nint(ds_parent(nb_dimensions)/ds_child(nb_dimensions)) + enddo + ENDIF + + WHERE (tempCextend%array2 == Agrif_SpecialValueFineGrid) + tempC_indic%array2 = 0. + ELSEWHERE + tempC_indic%array2 = 1. + END WHERE + + Agrif_UseSpecialValueInUpdate = .FALSE. + Agrif_Update_Weights = .TRUE. + + call Agrif_Update_2D_Recursive( type_update_temp(1:2), & + tempP_indic%array2, & + tempC_indic%array2, & + indmin(1:2), indmax(1:2), & + pttruetabwhole(1:2), cetruetabwhole(1:2), & + s_Child_temp(1:2), s_Parent_temp(1:2), & + ds_child(1:2), ds_parent(1:2) ) + + Agrif_UseSpecialValueInUpdate = .TRUE. + Agrif_Update_Weights = .FALSE. + + IF (compute_average) THEN + WHERE (tempP_indic%array2 == 0.) + tempP%array2 = Agrif_SpecialValueFineGrid + ELSEWHERE ((tempP_indic%array2 == coeff_multi).AND.(tempP%array2 /= Agrif_SpecialValueFineGrid)) + tempP%array2 = tempP%array2 /tempP_indic%array2 + ELSEWHERE + tempP%array2 = tempP_average%array2 /tempP_indic%array2 + END WHERE + + ELSE + WHERE (tempP_indic%array2 == 0.) + tempP%array2 = Agrif_SpecialValueFineGrid + ELSEWHERE + tempP%array2 = tempP%array2 /tempP_indic%array2 + END WHERE + ENDIF + + deallocate(tempP_indic%array2) + deallocate(tempC_indic%array2) + deallocate(tempC_indic) + deallocate(tempP_indic) + IF (compute_average) THEN + deallocate(tempP_average%array2) + deallocate(tempP_average) + ENDIF + ENDIF + + endif + if ( nbdim == 3 ) then + call Agrif_Update_3D_Recursive( type_update(1:3), & + tempP%array3, & + tempCextend%array3, & + indmin(1:3), indmax(1:3), & + pttruetabwhole(1:3), cetruetabwhole(1:3), & + s_Child_temp(1:3), s_Parent_temp(1:3), & + ds_child(1:3), ds_parent(1:3) ) + + IF (Agrif_UseSpecialValueInUpdate) THEN + allocate(tempC_indic) + allocate(tempP_indic) + call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array3),ubound(tempCextend%array3),nbdim) + call Agrif_array_allocate(tempP_indic,lbound(tempP%array3),ubound(tempP%array3),nbdim) + + compute_average = .FALSE. + type_update_temp(1:nbdim) = type_update(1:nbdim) + IF (ANY(type_update == Agrif_Update_Full_Weighting)) THEN + compute_average = .TRUE. + allocate(tempP_average) + call Agrif_array_allocate(tempP_average,lbound(tempP%array3),ubound(tempP%array3),nbdim) + WHERE (type_update(1:nbdim) == Agrif_Update_Full_Weighting) + type_update_temp(1:nbdim) = Agrif_Update_Average + END WHERE + call Agrif_Update_3D_Recursive( type_update_temp(1:3), & + tempP_average%array3, & + tempCextend%array3, & + indmin(1:3), indmax(1:3), & + pttruetabwhole(1:3), cetruetabwhole(1:3), & + s_Child_temp(1:3), s_Parent_temp(1:3), & + ds_child(1:3), ds_parent(1:3) ) + coeff_multi = 1. + do nb_dimensions=1,nbdim + coeff_multi = coeff_multi * nint(ds_parent(nb_dimensions)/ds_child(nb_dimensions)) + enddo + ENDIF + + WHERE (tempCextend%array3 == Agrif_SpecialValueFineGrid) + tempC_indic%array3 = 0. + ELSEWHERE + tempC_indic%array3 = 1. + END WHERE + + Agrif_UseSpecialValueInUpdate = .FALSE. + Agrif_Update_Weights = .TRUE. + + call Agrif_Update_3D_Recursive( type_update_temp(1:3), & + tempP_indic%array3, & + tempC_indic%array3, & + indmin(1:3), indmax(1:3), & + pttruetabwhole(1:3), cetruetabwhole(1:3), & + s_Child_temp(1:3), s_Parent_temp(1:3), & + ds_child(1:3), ds_parent(1:3) ) + + Agrif_UseSpecialValueInUpdate = .TRUE. + Agrif_Update_Weights = .FALSE. + + IF (compute_average) THEN + WHERE (tempP_indic%array3 == 0.) + tempP%array3 = Agrif_SpecialValueFineGrid + ELSEWHERE ((tempP_indic%array3 == coeff_multi).AND.(tempP%array3 /= Agrif_SpecialValueFineGrid)) + tempP%array3 = tempP%array3 /tempP_indic%array3 + ELSEWHERE + tempP%array3 = tempP_average%array3 /tempP_indic%array3 + END WHERE + + ELSE + WHERE (tempP_indic%array3 == 0.) + tempP%array3 = Agrif_SpecialValueFineGrid + ELSEWHERE + tempP%array3 = tempP%array3 /tempP_indic%array3 + END WHERE + ENDIF + + deallocate(tempP_indic%array3) + deallocate(tempC_indic%array3) + deallocate(tempC_indic) + deallocate(tempP_indic) + IF (compute_average) THEN + deallocate(tempP_average%array3) + deallocate(tempP_average) + ENDIF + ENDIF + + endif + if ( nbdim == 4 ) then + call Agrif_Update_4D_Recursive( type_update(1:4), & + tempP%array4, & + tempCextend%array4, & + indmin(1:4), indmax(1:4), & + pttruetabwhole(1:4), cetruetabwhole(1:4), & + s_Child_temp(1:4), s_Parent_temp(1:4), & + ds_child(1:4), ds_parent(1:4) ) + + IF (Agrif_UseSpecialValueInUpdate) THEN + + allocate(tempC_indic) + allocate(tempP_indic) + call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array4),ubound(tempCextend%array4),nbdim) + call Agrif_array_allocate(tempP_indic,lbound(tempP%array4),ubound(tempP%array4),nbdim) + + compute_average = .FALSE. + type_update_temp(1:nbdim) = type_update(1:nbdim) + IF (ANY(type_update == Agrif_Update_Full_Weighting)) THEN + compute_average = .TRUE. + allocate(tempP_average) + call Agrif_array_allocate(tempP_average,lbound(tempP%array4),ubound(tempP%array4),nbdim) + WHERE (type_update(1:nbdim) == Agrif_Update_Full_Weighting) + type_update_temp(1:nbdim) = Agrif_Update_Average + END WHERE + call Agrif_Update_4D_Recursive( type_update_temp(1:4), & + tempP_average%array4, & + tempCextend%array4, & + indmin(1:4), indmax(1:4), & + pttruetabwhole(1:4), cetruetabwhole(1:4), & + s_Child_temp(1:4), s_Parent_temp(1:4), & + ds_child(1:4), ds_parent(1:4) ) + coeff_multi = 1. + do nb_dimensions=1,nbdim + coeff_multi = coeff_multi * nint(ds_parent(nb_dimensions)/ds_child(nb_dimensions)) + enddo + ENDIF + + WHERE (tempCextend%array4 == Agrif_SpecialValueFineGrid) + tempC_indic%array4 = 0. + ELSEWHERE + tempC_indic%array4 = 1. + END WHERE + + Agrif_UseSpecialValueInUpdate = .FALSE. + Agrif_Update_Weights = .TRUE. + + call Agrif_Update_4D_Recursive( type_update_temp(1:4), & + tempP_indic%array4, & + tempC_indic%array4, & + indmin(1:4), indmax(1:4), & + pttruetabwhole(1:4), cetruetabwhole(1:4), & + s_Child_temp(1:4), s_Parent_temp(1:4), & + ds_child(1:4), ds_parent(1:4) ) + + Agrif_UseSpecialValueInUpdate = .TRUE. + Agrif_Update_Weights = .FALSE. + + IF (compute_average) THEN + WHERE (tempP_indic%array4 == 0.) + tempP%array4 = Agrif_SpecialValueFineGrid + ELSEWHERE ((tempP_indic%array4 == coeff_multi).AND.(tempP%array4 /= Agrif_SpecialValueFineGrid)) + tempP%array4 = tempP%array4 /tempP_indic%array4 + ELSEWHERE + tempP%array4 = tempP_average%array4 /tempP_indic%array4 + END WHERE + + ELSE + WHERE (tempP_indic%array4 == 0.) + tempP%array4 = Agrif_SpecialValueFineGrid + ELSEWHERE + tempP%array4 = tempP%array4 /tempP_indic%array4 + END WHERE + ENDIF + deallocate(tempP_indic%array4) + deallocate(tempC_indic%array4) + deallocate(tempC_indic) + deallocate(tempP_indic) + IF (compute_average) THEN + deallocate(tempP_average%array4) + deallocate(tempP_average) + ENDIF + ENDIF + + endif + if ( nbdim == 5 ) then + call Agrif_Update_5D_Recursive( type_update(1:5), & + tempP%array5, & + tempCextend%array5, & + indmin(1:5), indmax(1:5), & + pttruetabwhole(1:5), cetruetabwhole(1:5), & + s_Child_temp(1:5), s_Parent_temp(1:5), & + ds_child(1:5), ds_parent(1:5) ) + + IF (Agrif_UseSpecialValueInUpdate) THEN + allocate(tempC_indic) + allocate(tempP_indic) + call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array5),ubound(tempCextend%array5),nbdim) + call Agrif_array_allocate(tempP_indic,lbound(tempP%array5),ubound(tempP%array5),nbdim) + + compute_average = .FALSE. + type_update_temp(1:nbdim) = type_update(1:nbdim) + IF (ANY(type_update == Agrif_Update_Full_Weighting)) THEN + compute_average = .TRUE. + allocate(tempP_average) + call Agrif_array_allocate(tempP_average,lbound(tempP%array5),ubound(tempP%array5),nbdim) + WHERE (type_update(1:nbdim) == Agrif_Update_Full_Weighting) + type_update_temp(1:nbdim) = Agrif_Update_Average + END WHERE + call Agrif_Update_5D_Recursive( type_update_temp(1:5), & + tempP_average%array5, & + tempCextend%array5, & + indmin(1:5), indmax(1:5), & + pttruetabwhole(1:5), cetruetabwhole(1:5), & + s_Child_temp(1:5), s_Parent_temp(1:5), & + ds_child(1:5), ds_parent(1:5) ) + coeff_multi = 1. + do nb_dimensions=1,nbdim + coeff_multi = coeff_multi * nint(ds_parent(nb_dimensions)/ds_child(nb_dimensions)) + enddo + ENDIF + + WHERE (tempCextend%array5 == Agrif_SpecialValueFineGrid) + tempC_indic%array5 = 0. + ELSEWHERE + tempC_indic%array5 = 1. + END WHERE + + Agrif_UseSpecialValueInUpdate = .FALSE. + Agrif_Update_Weights = .TRUE. + + call Agrif_Update_5D_Recursive( type_update_temp(1:5), & + tempP_indic%array5, & + tempC_indic%array5, & + indmin(1:5), indmax(1:5), & + pttruetabwhole(1:5), cetruetabwhole(1:5), & + s_Child_temp(1:5), s_Parent_temp(1:5), & + ds_child(1:5), ds_parent(1:5) ) + + Agrif_UseSpecialValueInUpdate = .TRUE. + Agrif_Update_Weights = .FALSE. + + IF (compute_average) THEN + WHERE (tempP_indic%array5 == 0.) + tempP%array5 = Agrif_SpecialValueFineGrid + ELSEWHERE ((tempP_indic%array5 == coeff_multi).AND.(tempP%array5 /= Agrif_SpecialValueFineGrid)) + tempP%array5 = tempP%array5 /tempP_indic%array5 + ELSEWHERE + tempP%array5 = tempP_average%array5 /tempP_indic%array5 + END WHERE + + ELSE + WHERE (tempP_indic%array5 == 0.) + tempP%array5 = Agrif_SpecialValueFineGrid + ELSEWHERE + tempP%array5 = tempP%array5 /tempP_indic%array5 + END WHERE + ENDIF + + deallocate(tempP_indic%array5) + deallocate(tempC_indic%array5) + deallocate(tempC_indic) + deallocate(tempP_indic) + IF (compute_average) THEN + deallocate(tempP_average%array5) + deallocate(tempP_average) + ENDIF + ENDIF + + endif + if ( nbdim == 6 ) then + call Agrif_Update_6D_Recursive( type_update(1:6), & + tempP%array6, & + tempCextend%array6, & + indmin(1:6), indmax(1:6), & + pttruetabwhole(1:6), cetruetabwhole(1:6), & + s_Child_temp(1:6), s_Parent_temp(1:6), & + ds_child(1:6), ds_parent(1:6) ) + IF (Agrif_UseSpecialValueInUpdate) THEN + allocate(tempC_indic) + allocate(tempP_indic) + call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array6),ubound(tempCextend%array6),nbdim) + call Agrif_array_allocate(tempP_indic,lbound(tempP%array6),ubound(tempP%array6),nbdim) + + compute_average = .FALSE. + type_update_temp(1:nbdim) = type_update(1:nbdim) + IF (ANY(type_update == Agrif_Update_Full_Weighting)) THEN + compute_average = .TRUE. + allocate(tempP_average) + call Agrif_array_allocate(tempP_average,lbound(tempP%array6),ubound(tempP%array6),nbdim) + type_update_temp(1:nbdim) = type_update + WHERE (type_update(1:nbdim) == Agrif_Update_Full_Weighting) + type_update_temp(1:nbdim) = Agrif_Update_Average + END WHERE + call Agrif_Update_6D_Recursive( type_update_temp(1:6), & + tempP_average%array6, & + tempCextend%array6, & + indmin(1:6), indmax(1:6), & + pttruetabwhole(1:6), cetruetabwhole(1:6), & + s_Child_temp(1:6), s_Parent_temp(1:6), & + ds_child(1:6), ds_parent(1:6) ) + coeff_multi = 1. + do nb_dimensions=1,nbdim + coeff_multi = coeff_multi * nint(ds_parent(nb_dimensions)/ds_child(nb_dimensions)) + enddo + ENDIF + + IF (compute_average) THEN + WHERE (tempP_indic%array6 == 0.) + tempP%array6 = Agrif_SpecialValueFineGrid + ELSEWHERE ((tempP_indic%array6 == coeff_multi).AND.(tempP%array6 /= Agrif_SpecialValueFineGrid)) + tempP%array6 = tempP%array6 /tempP_indic%array6 + ELSEWHERE + tempP%array6 = tempP_average%array6 /tempP_indic%array6 + END WHERE + + ELSE + WHERE (tempP_indic%array6 == 0.) + tempP%array6 = Agrif_SpecialValueFineGrid + ELSEWHERE + tempP%array6 = tempP%array6 /tempP_indic%array6 + END WHERE + ENDIF + + Agrif_UseSpecialValueInUpdate = .FALSE. + Agrif_Update_Weights = .TRUE. + + call Agrif_Update_6D_Recursive( type_update_temp(1:6), & + tempP_indic%array6, & + tempC_indic%array6, & + indmin(1:6), indmax(1:6), & + pttruetabwhole(1:6), cetruetabwhole(1:6), & + s_Child_temp(1:6), s_Parent_temp(1:6), & + ds_child(1:6), ds_parent(1:6) ) + + Agrif_UseSpecialValueInUpdate = .TRUE. + Agrif_Update_Weights = .FALSE. + + WHERE (tempP_indic%array6 == 0.) + tempP%array6 = Agrif_SpecialValueFineGrid + ELSEWHERE + tempP%array6 = tempP%array6 /tempP_indic%array6 + END WHERE + + deallocate(tempP_indic%array6) + deallocate(tempC_indic%array6) + deallocate(tempC_indic) + deallocate(tempP_indic) + IF (compute_average) THEN + deallocate(tempP_average%array6) + deallocate(tempP_average) + ENDIF + ENDIF + endif +! + call Agrif_array_deallocate(tempCextend,nbdim) +! + ENDIF + +#if defined AGRIF_MPI + local_proc = Agrif_Procrank + call Agrif_get_var_bounds_array(parent,lowerbound,upperbound,nbdim) + call Agrif_ChildGrid_to_ParentGrid() + call Agrif_Childbounds(nbdim, lowerbound, upperbound, & + indminglob, indmaxglob, local_proc, coords, & + indminglob2, indmaxglob2, member) +! + IF (member) THEN + call Agrif_GlobalToLocalBounds(parentarray, lowerbound, upperbound, & + indminglob2, indmaxglob2, coords, & + nbdim, local_proc, member) + ENDIF + + call Agrif_ParentGrid_to_ChildGrid() + + if (.not.find_list_update) then + tab3(:,1) = indmin(:) + tab3(:,2) = indmax(:) + tab3(:,3) = indminglob2(:) + tab3(:,4) = indmaxglob2(:) +! + call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim,MPI_INTEGER,Agrif_mpi_comm,code) + + IF ( .not.associated(tempPextend) ) allocate(tempPextend) + DO k=0,Agrif_Nbprocs-1 + do j=1,4 + do i=1,nbdim + tab5t(i,k,j) = tab4(i,j,k) + enddo + enddo + enddo + + memberin1(1) = member + call MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall2,1,MPI_LOGICAL,Agrif_mpi_comm,code) + call Get_External_Data_first(tab5t(:,:,1),tab5t(:,:,2),tab5t(:,:,3),tab5t(:,:,4), & + nbdim, memberinall2, coords, & + sendtoproc2, recvfromproc2, & + tab5t(:,:,5),tab5t(:,:,6),tab5t(:,:,7),tab5t(:,:,8), & + tab5t(:,:,1),tab5t(:,:,2)) + + call Agrif_Addto_list_update(child%list_update,pttab,petab,lb_child,lb_parent, & + nbdim,tab4t,tab5t,memberinall,memberinall2, & + sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2) + + endif + + call ExchangeSameLevel(sendtoproc2,recvfromproc2,nbdim, & + tab5t(:,:,3),tab5t(:,:,4),tab5t(:,:,5),tab5t(:,:,6),& + tab5t(:,:,7),tab5t(:,:,8),member,tempP,tempPextend) +#else + tempPextend => tempP + parentarray(:,1,1) = indmin + parentarray(:,2,1) = indmax + parentarray(:,1,2) = indmin + parentarray(:,2,2) = indmax + member = .TRUE. +#endif +! +! Special values on the child grid + if ( Agrif_UseSpecialValueFineGrid ) then +! +!cc noraftab(1:nbdim) = +!cc & child % root_var % interptab(1:nbdim) == 'N' +! +#if defined AGRIF_MPI +! +! allocate(childvalues% var) +! +! Call Agrif_array_allocate(childvalues%var, +! & pttruetab,cetruetab,nbdim) +! Call Agrif_var_full_copy_array(childvalues% var, +! & tempC, +! & nbdim) +! Call Agrif_CheckMasknD(tempC,childvalues, +! & pttruetab(1:nbdim),cetruetab(1:nbdim), +! & pttruetab(1:nbdim),cetruetab(1:nbdim), +! & noraftab(1:nbdim),nbdim) +! Call Agrif_array_deallocate(childvalues% var,nbdim) +! Deallocate(childvalues % var) +! +#else +! +! Call Agrif_get_var_bounds_array(child, +! & lowerbound,upperbound,nbdim) +! Call Agrif_CheckMasknD(tempC,child, +! & pttruetab(1:nbdim),cetruetab(1:nbdim), +! & lowerbound, +! & upperbound, +! & noraftab(1:nbdim),nbdim) +! +#endif +! + endif +! +! Special values on the parent grid + if (Agrif_UseSpecialValue) then +! +#if defined AGRIF_MPI +! +! Call GiveAgrif_SpecialValueToTab_mpi(parent,tempP, +! & parentarray, +! & Agrif_SpecialValue,nbdim) +! +! +#else +! +! Call GiveAgrif_SpecialValueToTab(parent,tempP, +! & indmin,indmax, +! & Agrif_SpecialValue,nbdim) +! +#endif +! + endif +! + IF (member) THEN + + call Agrif_ChildGrid_to_ParentGrid() +! + SELECT CASE(nbdim) + CASE(1) + call procname( tempPextend % array1( & + parentarray(1,1,1):parentarray(1,2,1)), & + parentarray(1,1,2),parentarray(1,2,2),.FALSE.,nbin,ndirin) + CASE(2) + call procname( tempPextend % array2( & + parentarray(1,1,1):parentarray(1,2,1), & + parentarray(2,1,1):parentarray(2,2,1)), & + parentarray(1,1,2),parentarray(1,2,2), & + parentarray(2,1,2),parentarray(2,2,2),.FALSE.,nbin,ndirin) + CASE(3) + call procname( tempPextend % array3( & + parentarray(1,1,1):parentarray(1,2,1), & + parentarray(2,1,1):parentarray(2,2,1), & + parentarray(3,1,1):parentarray(3,2,1)), & + parentarray(1,1,2),parentarray(1,2,2), & + parentarray(2,1,2),parentarray(2,2,2), & + parentarray(3,1,2),parentarray(3,2,2),.FALSE.,nbin,ndirin) + CASE(4) + call procname( tempPextend % array4( & + parentarray(1,1,1):parentarray(1,2,1), & + parentarray(2,1,1):parentarray(2,2,1), & + parentarray(3,1,1):parentarray(3,2,1), & + parentarray(4,1,1):parentarray(4,2,1)), & + parentarray(1,1,2),parentarray(1,2,2), & + parentarray(2,1,2),parentarray(2,2,2), & + parentarray(3,1,2),parentarray(3,2,2), & + parentarray(4,1,2),parentarray(4,2,2),.FALSE.,nbin,ndirin) + CASE(5) + call procname( tempPextend % array5( & + parentarray(1,1,1):parentarray(1,2,1), & + parentarray(2,1,1):parentarray(2,2,1), & + parentarray(3,1,1):parentarray(3,2,1), & + parentarray(4,1,1):parentarray(4,2,1), & + parentarray(5,1,1):parentarray(5,2,1)), & + parentarray(1,1,2),parentarray(1,2,2), & + parentarray(2,1,2),parentarray(2,2,2), & + parentarray(3,1,2),parentarray(3,2,2), & + parentarray(4,1,2),parentarray(4,2,2), & + parentarray(5,1,2),parentarray(5,2,2),.FALSE.,nbin,ndirin) + CASE(6) + call procname( tempPextend % array6( & + parentarray(1,1,1):parentarray(1,2,1), & + parentarray(2,1,1):parentarray(2,2,1), & + parentarray(3,1,1):parentarray(3,2,1), & + parentarray(4,1,1):parentarray(4,2,1), & + parentarray(5,1,1):parentarray(5,2,1), & + parentarray(6,1,1):parentarray(6,2,1)), & + parentarray(1,1,2),parentarray(1,2,2), & + parentarray(2,1,2),parentarray(2,2,2), & + parentarray(3,1,2),parentarray(3,2,2), & + parentarray(4,1,2),parentarray(4,2,2), & + parentarray(5,1,2),parentarray(5,2,2), & + parentarray(6,1,2),parentarray(6,2,2),.FALSE.,nbin,ndirin) + END SELECT +! + call Agrif_ParentGrid_to_ChildGrid() +! + call Agrif_array_deallocate(tempPextend,nbdim) +! + ENDIF +! +#if defined AGRIF_MPI + IF (memberin) THEN + call Agrif_array_deallocate(tempP,nbdim) + call Agrif_array_deallocate(tempC,nbdim) + ENDIF +#endif +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_UpdatenD +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Prtbounds +! +!> calculates the bounds of the parent grid to be updated by the child grid +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Prtbounds ( nbdim, indmin, indmax, s_Parent_temp, s_Child_temp, & + s_child, ds_child, s_parent, ds_parent, & + pttruetab, cetruetab, lb_child, lb_parent & +#if defined AGRIF_MPI + ,posvar, type_update, do_update, & + pttruetabwhole, cetruetabwhole & +#endif + ) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: nbdim + integer, dimension(nbdim), intent(out) :: indmin, indmax + real, dimension(nbdim), intent(out) :: s_Parent_temp, s_Child_temp + real, dimension(nbdim), intent(in) :: s_child, ds_child + real, dimension(nbdim), intent(in) :: s_parent, ds_parent + integer, dimension(nbdim), intent(in) :: pttruetab, cetruetab + integer, dimension(nbdim), intent(in) :: lb_child, lb_parent +#if defined AGRIF_MPI + integer, dimension(nbdim), intent(in) :: posvar !< Position of the variable on the cell (1 or 2) + integer, dimension(nbdim), intent(in) :: type_update + logical, dimension(nbdim), intent(in) :: do_update + integer,dimension(nbdim), intent(out) :: pttruetabwhole, cetruetabwhole +#endif +! + real,dimension(nbdim) :: dim_newmin,dim_newmax + integer :: i +#if defined AGRIF_MPI + real :: positionmin, positionmax + integer :: imin, imax + integer :: coeffraf +#endif +! + do i = 1,nbdim +! + dim_newmin(i) = s_child(i) + (pttruetab(i) - lb_child(i)) * ds_child(i) + dim_newmax(i) = s_child(i) + (cetruetab(i) - lb_child(i)) * ds_child(i) +! + indmin(i) = lb_parent(i) + agrif_ceiling((dim_newmin(i)-s_parent(i))/ds_parent(i)) + indmax(i) = lb_parent(i) + agrif_int( (dim_newmax(i)-s_parent(i))/ds_parent(i)) +! +#if defined AGRIF_MPI + positionmin = s_parent(i) + (indmin(i)-lb_parent(i))*ds_parent(i) + IF ( do_update(i) ) THEN + IF (posvar(i) == 1) THEN + IF (type_update(i) == Agrif_Update_Average) THEN + positionmin = positionmin - ds_parent(i)/2. + ELSE IF (type_update(i) == Agrif_Update_Full_Weighting) THEN + positionmin = positionmin - (ds_parent(i)-ds_child(i)) + ENDIF + ELSE + IF (type_update(i) /= Agrif_Update_Full_Weighting) THEN + positionmin = positionmin - ds_parent(i)/2. + ELSE + coeffraf = nint(ds_parent(i)/ds_child(i)) + if (mod(coeffraf,2) == 1) then + positionmin = positionmin - (ds_parent(i)-ds_child(i)) + else + positionmin = positionmin - (ds_parent(i)-ds_child(i))-ds_child(i)/2. + endif + ENDIF + ENDIF + ENDIF +! + imin = lb_child(i) + agrif_ceiling((positionmin-s_child(i))/ds_child(i)) + positionmin = s_child(i) + (imin - lb_child(i)) * ds_child(i) + positionmax = s_parent(i) + (indmax(i)-lb_parent(i))*ds_parent(i) + pttruetabwhole(i) = imin + + IF ( do_update(i) ) THEN + IF (posvar(i) == 1) THEN + IF (type_update(i) == Agrif_Update_Average) THEN + positionmax = positionmax + ds_parent(i)/2. + ELSE IF (type_update(i) == Agrif_Update_Full_Weighting) THEN + positionmax = positionmax + (ds_parent(i)-ds_child(i)) + ENDIF + ELSE + IF (type_update(i) /= Agrif_Update_Full_Weighting) THEN + positionmax = positionmax + ds_parent(i)/2. + ELSE + coeffraf = nint(ds_parent(i)/ds_child(i)) + if (mod(coeffraf,2) == 1) then + positionmax = positionmax + (ds_parent(i)-ds_child(i)) + else + positionmax = positionmax + (ds_parent(i)-ds_child(i)) + ds_child(i)/2. + endif + ENDIF + ENDIF + ENDIF + + imax = lb_child(i) +agrif_int((positionmax-s_child(i))/ds_child(i)) + positionmax = s_child(i) + (imax - lb_child(i)) * ds_child(i) + cetruetabwhole(i) = imax +#endif +! + s_Parent_temp(i) = s_parent(i) + (indmin(i) - lb_parent(i)) * ds_parent(i) + s_Child_temp(i) = dim_newmin(i) + +#if defined AGRIF_MPI + s_Child_temp(i) = positionmin +#endif +! + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Prtbounds +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Update_1D_Recursive +! +!> Updates a 1D grid variable on the parent grid +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Update_1D_Recursive ( type_update, & + tempP, tempC, & + indmin, indmax, & + lb_child, ub_child, & + s_child, s_parent, & + ds_child, ds_parent ) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: type_update !< Type of update (copy or average) + integer, intent(in) :: indmin, indmax + integer, intent(in) :: lb_child, ub_child + real, intent(in) :: s_child, s_parent + real, intent(in) :: ds_child, ds_parent + real, dimension(indmin:indmax), intent(out) :: tempP + real, dimension(lb_child:ub_child), intent(in) :: tempC +!--------------------------------------------------------------------------------------------------- + call Agrif_UpdateBase(type_update, & + tempP(indmin:indmax), & + tempC(lb_child:ub_child), & + indmin, indmax, & + lb_child, ub_child, & + s_parent, s_child, & + ds_parent, ds_child) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Update_1D_Recursive +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Update_2D_Recursive +! +!> updates a 2D grid variable on the parent grid. +!! Calls #Agrif_Update_1D_Recursive and #Agrif_UpdateBase +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Update_2D_Recursive ( type_update, & + tempP, tempC, & + indmin, indmax, & + lb_child, ub_child, & + s_child, s_parent, & + ds_child, ds_parent ) +!--------------------------------------------------------------------------------------------------- + integer, dimension(2), intent(in) :: type_update !< Type of update (copy or average) + integer, dimension(2), intent(in) :: indmin, indmax + integer, dimension(2), intent(in) :: lb_child, ub_child + real, dimension(2), intent(in) :: s_child, s_parent + real, dimension(2), intent(in) :: ds_child, ds_parent + real, dimension( & + indmin(1):indmax(1), & + indmin(2):indmax(2)), intent(out) :: tempP + real, dimension(:,:), intent(in) :: tempC +!--------------------------------------------------------------------------------------------------- + real, dimension(indmin(1):indmax(1), lb_child(2):ub_child(2)) :: tabtemp + real, dimension(indmin(2):indmax(2), indmin(1):indmax(1)) :: tempP_trsp + real, dimension(lb_child(2):ub_child(2), indmin(1):indmax(1)) :: tabtemp_trsp + integer :: i, j + integer :: coeffraf +! + tabtemp = 0. + coeffraf = nint ( ds_parent(1) / ds_child(1) ) +! + IF((type_update(1) == Agrif_Update_Average) .AND. (coeffraf /= 1 )) THEN +!---CDIR NEXPAND + if ( .NOT. precomputedone(1) ) then + call Average1dPrecompute( ub_child(2)-lb_child(2)+1, & + indmax(1)-indmin(1)+1, & + ub_child(1)-lb_child(1)+1, & + s_parent(1),s_child(1),ds_parent(1),ds_child(1),1) +! precomputedone(1) = .TRUE. + endif +!---CDIR NEXPAND + call Average1dAfterCompute( tabtemp, tempC, size(tabtemp), size(tempC), & + s_parent(1),s_child(1),ds_parent(1),ds_child(1),1) +! + ELSE IF ((type_update(1) == Agrif_Update_Copy) .AND. (coeffraf /= 1 ))THEN +!---CDIR NEXPAND + if ( .NOT. precomputedone(1) ) then + call Agrif_basicupdate_copy1d_before( ub_child(2)-lb_child(2)+1, & + indmax(1)-indmin(1)+1, & + ub_child(1)-lb_child(1)+1, & + s_parent(1),s_child(1),ds_parent(1),ds_child(1),1) +! precomputedone(1) = .TRUE. + endif +!---CDIR NEXPAND + call Agrif_basicupdate_copy1d_after(tabtemp,tempC,size(tabtemp),size(tempC),1) +! + ELSE + do j = lb_child(2),ub_child(2) +! +!---CDIR NEXPAND + call Agrif_Update_1D_Recursive( type_update(1), & + tabtemp(:,j), & + tempC(:,j-lb_child(2)+1), & + indmin(1), indmax(1), & + lb_child(1),ub_child(1), & + s_child(1), s_parent(1), & + ds_child(1),ds_parent(1)) + enddo + ENDIF +! + tabtemp_trsp = TRANSPOSE(tabtemp) + coeffraf = nint(ds_parent(2)/ds_child(2)) +! + tempP_trsp = 0. +! + IF((type_update(2) == Agrif_Update_Average) .AND. (coeffraf /= 1 )) THEN +!---CDIR NEXPAND + if ( .NOT. precomputedone(2) ) then + call Average1dPrecompute( indmax(1)-indmin(1)+1, & + indmax(2)-indmin(2)+1, & + ub_child(2)-lb_child(2)+1,& + s_parent(2),s_child(2),ds_parent(2),ds_child(2),2) +! precomputedone(2) = .TRUE. + endif +!---CDIR NEXPAND + call Average1dAfterCompute( tempP_trsp, tabtemp_trsp, size(tempP_trsp), size(tabtemp_trsp),& + s_parent(2),s_child(2),ds_parent(2),ds_child(2),2) +! + ELSE IF ((type_update(2) == Agrif_Update_Copy) .AND. (coeffraf /= 1 )) THEN +!---CDIR NEXPAND + if ( .NOT. precomputedone(2) ) then + call Agrif_basicupdate_copy1d_before( indmax(1)-indmin(1)+1, & + indmax(2)-indmin(2)+1, & + ub_child(2)-lb_child(2)+1, & + s_parent(2),s_child(2),ds_parent(2),ds_child(2),2) +! precomputedone(2) = .TRUE. + endif +!---CDIR NEXPAND + call Agrif_basicupdate_copy1d_after( tempP_trsp, tabtemp_trsp, size(tempP_trsp), size(tabtemp_trsp),2) +! + ELSE + do i = indmin(1),indmax(1) +! +!---CDIR NEXPAND + call Agrif_UpdateBase(type_update(2), & + tempP_trsp(indmin(2):indmax(2),i), & + tabtemp_trsp(lb_child(2):ub_child(2),i),& + indmin(2),indmax(2), & + lb_child(2),ub_child(2), & + s_parent(2),s_child(2), & + ds_parent(2),ds_child(2)) +! + enddo + ENDIF +! + tempP = TRANSPOSE(tempP_trsp) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Update_2D_Recursive +!=================================================================================================== +! +subroutine Agrif_Update_2D_Recursive_ok ( type_update, & + tempP, tempC, & + indmin, indmax, & + lb_child, ub_child, & + s_child, s_parent, ds_child, ds_parent ) +!--------------------------------------------------------------------------------------------------- + INTEGER, DIMENSION(2), intent(in) :: type_update !< Type of update (copy or average) + INTEGER, DIMENSION(2), intent(in) :: indmin, indmax + INTEGER, DIMENSION(2), intent(in) :: lb_child, ub_child + REAL, DIMENSION(2), intent(in) :: s_child, s_parent + REAL, DIMENSION(2), intent(in) :: ds_child, ds_parent + REAL, DIMENSION( & + indmin(1):indmax(1), & + indmin(2):indmax(2)), intent(out) :: tempP + REAL, DIMENSION( & + lb_child(1):ub_child(1), & + lb_child(2):ub_child(2)), intent(in) :: tempC +! + REAL, DIMENSION(indmin(1):indmax(1), lb_child(2):ub_child(2)) :: tabtemp + INTEGER :: i +! + do i = lb_child(2),ub_child(2) + call Agrif_Update_1D_Recursive(type_update(1), & + tabtemp(:, i), & + tempC(:,i), & + indmin(1),indmax(1), & + lb_child(1),ub_child(1), & + s_child(1), s_parent(1), & + ds_child(1),ds_parent(1)) + enddo +! + tempP = 0. +! + do i = indmin(1),indmax(1) + call Agrif_UpdateBase(type_update(2), & + tempP(i,:), & + tabtemp(i,:), & + indmin(2),indmax(2), & + lb_child(2),ub_child(2), & + s_parent(2),s_child(2), & + ds_parent(2),ds_child(2)) + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Update_2D_Recursive_ok +!=================================================================================================== + +! +!=================================================================================================== +! subroutine Agrif_Update_3D_Recursive +! +!> Updates a 3D grid variable on the parent grid. +!! Calls #Agrif_Update_2D_Recursive and #Agrif_UpdateBase. +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Update_3D_Recursive ( type_update, & + tempP, tempC, & + indmin, indmax, & + lb_child, ub_child, & + s_child, s_parent, & + ds_child, ds_parent ) +!--------------------------------------------------------------------------------------------------- + integer, dimension(3), intent(in) :: type_update !< Type of update (copy or average) + integer, dimension(3), intent(in) :: indmin, indmax + integer, dimension(3), intent(in) :: lb_child, ub_child + real, dimension(3), intent(in) :: s_child, s_parent + real, dimension(3), intent(in) :: ds_child, ds_parent + real, dimension( & + indmin(1):indmax(1), & + indmin(2):indmax(2), & + indmin(3):indmax(3)), intent(out) :: tempP + real, dimension( & + lb_child(1):ub_child(1), & + lb_child(2):ub_child(2), & + lb_child(3):ub_child(3)), intent(in) :: tempC +!--------------------------------------------------------------------------------------------------- + real, dimension( & + indmin(1):indmax(1), & + indmin(2):indmax(2), & + lb_child(3):ub_child(3)) :: tabtemp + integer :: i,j,k + integer :: coeffraf,locind_child_left + integer :: kuinf +! + coeffraf = nint ( ds_parent(1) / ds_child(1) ) +! + if ((type_update(1) == Agrif_Update_Average) .AND. (coeffraf /= 1 )) then +!---CDIR NEXPAND + call Average1dPrecompute(ub_child(2)-lb_child(2)+1,& + indmax(1)-indmin(1)+1,& + ub_child(1)-lb_child(1)+1,& + s_parent(1),s_child(1),ds_parent(1),ds_child(1),1) + precomputedone(1) = .TRUE. + else if ((type_update(1) == Agrif_Update_Copy) .AND. (coeffraf /= 1 )) then +!---CDIR NEXPAND + call Agrif_basicupdate_copy1d_before(ub_child(2)-lb_child(2)+1, & + indmax(1)-indmin(1)+1, & + ub_child(1)-lb_child(1)+1, & + s_parent(1),s_child(1),ds_parent(1),ds_child(1),1) + precomputedone(1) = .TRUE. + endif +! + coeffraf = nint ( ds_parent(2) / ds_child(2) ) +! + if ((type_update(2) == Agrif_Update_Average) .AND. (coeffraf /= 1 )) then +!---CDIR NEXPAND + call Average1dPrecompute(indmax(1)-indmin(1)+1,& + indmax(2)-indmin(2)+1,& + ub_child(2)-lb_child(2)+1,& + s_parent(2),s_child(2),ds_parent(2),ds_child(2),2) + precomputedone(2) = .TRUE. + else if ((type_update(2) == Agrif_Update_Copy) .AND. (coeffraf /= 1 )) then +!---CDIR NEXPAND + call Agrif_basicupdate_copy1d_before( indmax(1)-indmin(1)+1, & + indmax(2)-indmin(2)+1, & + ub_child(2)-lb_child(2)+1, & + s_parent(2),s_child(2),ds_parent(2),ds_child(2),2) + precomputedone(2) = .TRUE. + endif +! + do k = lb_child(3),ub_child(3) + call Agrif_Update_2D_Recursive( type_update(1:2),tabtemp(:,:,k),tempC(:,:,k), & + indmin(1:2),indmax(1:2), & + lb_child(1:2),ub_child(1:2), & + s_child(1:2),s_parent(1:2), & + ds_child(1:2),ds_parent(1:2) ) + enddo +! + precomputedone(1) = .FALSE. + precomputedone(2) = .FALSE. +! + coeffraf = nint ( ds_parent(3) / ds_child(3) ) + locind_child_left = 1 + agrif_int((s_parent(3)-s_child(3))/ds_child(3)) +! + if (coeffraf == 1) then + kuinf = lb_child(3)+locind_child_left-2 + do k=indmin(3),indmax(3) + kuinf = kuinf + 1 + do j = indmin(2),indmax(2) + do i = indmin(1),indmax(1) + tempP(i,j,k) = tabtemp(i,j,kuinf) + enddo + enddo + enddo + else + tempP = 0. + do j = indmin(2),indmax(2) + do i = indmin(1),indmax(1) + call Agrif_UpdateBase(type_update(3),tempP(i,j,:),tabtemp(i,j,:), & + indmin(3),indmax(3), & + lb_child(3),ub_child(3), & + s_parent(3),s_child(3), & + ds_parent(3),ds_child(3)) +! + enddo + enddo + endif +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Update_3D_Recursive +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Update_4D_Recursive +! +!> Updates a 4D grid variable on the parent grid. +!! Calls #Agrif_Update_3D_Recursive and #Agrif_UpdateBase. +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Update_4D_Recursive ( type_update, & + tempP, tempC, & + indmin, indmax, & + lb_child, ub_child, & + s_child, s_parent, & + ds_child, ds_parent ) +!--------------------------------------------------------------------------------------------------- + integer, dimension(4), intent(in) :: type_update !< Type of update (copy or average) + integer, dimension(4), intent(in) :: indmin, indmax + integer, dimension(4), intent(in) :: lb_child, ub_child + real, dimension(4), intent(in) :: s_child, s_parent + real, dimension(4), intent(in) :: ds_child, ds_parent + real, dimension( & + indmin(1):indmax(1), & + indmin(2):indmax(2), & + indmin(3):indmax(3), & + indmin(4):indmax(4)), intent(out) :: tempP + real, dimension( & + lb_child(1):ub_child(1), & + lb_child(2):ub_child(2), & + lb_child(3):ub_child(3), & + lb_child(4):ub_child(4)), intent(in) :: tempC +!--------------------------------------------------------------------------------------------------- + real, dimension(:,:,:,:), allocatable :: tabtemp + integer :: i,j,k,l +! + allocate(tabtemp(indmin(1):indmax(1), & + indmin(2):indmax(2), & + indmin(3):indmax(3), & + lb_child(4):ub_child(4))) +! + do l = lb_child(4), ub_child(4) + call Agrif_Update_3D_Recursive(type_update(1:3), & + tabtemp(indmin(1):indmax(1), & + indmin(2):indmax(2), & + indmin(3):indmax(3), l), & + tempC(lb_child(1):ub_child(1), & + lb_child(2):ub_child(2), & + lb_child(3):ub_child(3), l), & + indmin(1:3), indmax(1:3), & + lb_child(1:3), ub_child(1:3), & + s_child(1:3), s_parent(1:3), & + ds_child(1:3), ds_parent(1:3)) + enddo +! + tempP = 0. +! + do k = indmin(3), indmax(3) + do j = indmin(2), indmax(2) + do i = indmin(1), indmax(1) + call Agrif_UpdateBase(type_update(4), & + tempP(i,j,k,indmin(4):indmax(4)), & + tabtemp(i,j,k,lb_child(4):ub_child(4)), & + indmin(4), indmax(4), & + lb_child(4), ub_child(4), & + s_parent(4), s_child(4), & + ds_parent(4),ds_child(4) ) + enddo + enddo + enddo +! + deallocate(tabtemp) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Update_4D_Recursive +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Update_5D_Recursive +! +!> Updates a 5D grid variable on the parent grid. +!! Calls #Agrif_Update_4D_Recursive and #Agrif_UpdateBase. +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Update_5D_Recursive ( type_update, & + tempP, tempC, & + indmin, indmax, & + lb_child, ub_child, & + s_child, s_parent, & + ds_child, ds_parent ) +!--------------------------------------------------------------------------------------------------- + integer, dimension(5), intent(in) :: type_update !< Type of update (copy or average) + integer, dimension(5), intent(in) :: indmin, indmax + integer, dimension(5), intent(in) :: lb_child, ub_child + real, dimension(5), intent(in) :: s_child, s_parent + real, dimension(5), intent(in) :: ds_child, ds_parent + real, dimension( & + indmin(1):indmax(1), & + indmin(2):indmax(2), & + indmin(3):indmax(3), & + indmin(4):indmax(4), & + indmin(5):indmax(5)), intent(out) :: tempP + real, dimension( & + lb_child(1):ub_child(1), & + lb_child(2):ub_child(2), & + lb_child(3):ub_child(3), & + lb_child(4):ub_child(4), & + lb_child(5):ub_child(5)), intent(in) :: tempC +!--------------------------------------------------------------------------------------------------- + real, dimension(:,:,:,:,:), allocatable :: tabtemp + integer :: i,j,k,l,m +! + allocate(tabtemp(indmin(1):indmax(1), & + indmin(2):indmax(2), & + indmin(3):indmax(3), & + indmin(4):indmax(4), & + lb_child(5):ub_child(5))) +! + do m = lb_child(5), ub_child(5) + call Agrif_Update_4D_Recursive(type_update(1:4), & + tabtemp(indmin(1):indmax(1), & + indmin(2):indmax(2), & + indmin(3):indmax(3), & + indmin(4):indmax(4), m), & + tempC(lb_child(1):ub_child(1), & + lb_child(2):ub_child(2), & + lb_child(3):ub_child(3), & + lb_child(4):ub_child(4), m), & + indmin(1:4),indmax(1:4), & + lb_child(1:4), ub_child(1:4), & + s_child(1:4), s_parent(1:4), & + ds_child(1:4), ds_parent(1:4)) + enddo +! + tempP = 0. +! + do l = indmin(4), indmax(4) + do k = indmin(3), indmax(3) + do j = indmin(2), indmax(2) + do i = indmin(1), indmax(1) + call Agrif_UpdateBase( type_update(5), & + tempP(i,j,k,l,indmin(5):indmax(5)), & + tabtemp(i,j,k,l,lb_child(5):ub_child(5)), & + indmin(5), indmax(5), & + lb_child(5), ub_child(5), & + s_parent(5), s_child(5), & + ds_parent(5),ds_child(5) ) + enddo + enddo + enddo + enddo +! + deallocate(tabtemp) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Update_5D_Recursive +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Update_6D_Recursive +! +!> Updates a 6D grid variable on the parent grid. +!! Calls #Agrif_Update_5D_Recursive and #Agrif_UpdateBase. +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Update_6D_Recursive ( type_update, & + tempP, tempC, & + indmin, indmax, & + lb_child, ub_child, & + s_child, s_parent, & + ds_child, ds_parent ) +!--------------------------------------------------------------------------------------------------- + integer, dimension(6), intent(in) :: type_update !< Type of update (copy or average) + integer, dimension(6), intent(in) :: indmin, indmax + integer, dimension(6), intent(in) :: lb_child, ub_child + real, dimension(6), intent(in) :: s_child, s_parent + real, dimension(6), intent(in) :: ds_child, ds_parent + real, dimension( & + indmin(1):indmax(1), & + indmin(2):indmax(2), & + indmin(3):indmax(3), & + indmin(4):indmax(4), & + indmin(5):indmax(5), & + indmin(6):indmax(6)), intent(out) :: tempP + real, dimension( & + lb_child(1):ub_child(1), & + lb_child(2):ub_child(2), & + lb_child(3):ub_child(3), & + lb_child(4):ub_child(4), & + lb_child(5):ub_child(5), & + lb_child(6):ub_child(6)), intent(in) :: tempC +!--------------------------------------------------------------------------------------------------- + real, dimension(:,:,:,:,:,:), allocatable :: tabtemp + integer :: i,j,k,l,m,n +! + allocate(tabtemp(indmin(1):indmax(1), & + indmin(2):indmax(2), & + indmin(3):indmax(3), & + indmin(4):indmax(4), & + indmin(5):indmax(5), & + lb_child(6):ub_child(6))) +! + do n = lb_child(6),ub_child(6) + call Agrif_Update_5D_Recursive(type_update(1:5), & + tabtemp(indmin(1):indmax(1), & + indmin(2):indmax(2), & + indmin(3):indmax(3), & + indmin(4):indmax(4), & + indmin(5):indmax(5), n), & + tempC(lb_child(1):ub_child(1), & + lb_child(2):ub_child(2), & + lb_child(3):ub_child(3), & + lb_child(4):ub_child(4), & + lb_child(5):ub_child(5), n), & + indmin(1:5), indmax(1:5), & + lb_child(1:5),ub_child(1:5), & + s_child(1:5), s_parent(1:5), & + ds_child(1:5),ds_parent(1:5)) + enddo +! + tempP = 0. +! + do m = indmin(5), indmax(5) + do l = indmin(4), indmax(4) + do k = indmin(3), indmax(3) + do j = indmin(2), indmax(2) + do i = indmin(1), indmax(1) + call Agrif_UpdateBase( type_update(6), & + tempP(i,j,k,l,m,indmin(6):indmax(6)), & + tabtemp(i,j,k,l,m,lb_child(6):ub_child(6)), & + indmin(6), indmax(6), & + lb_child(6), ub_child(6), & + s_parent(6), s_child(6), & + ds_parent(6), ds_child(6) ) + enddo + enddo + enddo + enddo + enddo +! + deallocate(tabtemp) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Update_6D_Recursive +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_UpdateBase +! +!> Calls the updating method chosen by the user (copy, average or full-weighting). +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_UpdateBase ( type_update, & + parent_tab, child_tab, & + indmin, indmax, & + lb_child, ub_child, & + s_parent, s_child, & + ds_parent, ds_child ) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: type_update + integer, intent(in) :: indmin, indmax + integer, intent(in) :: lb_child, ub_child + real, dimension(indmin:indmax), intent(out):: parent_tab + real, dimension(lb_child:ub_child), intent(in) :: child_tab + real, intent(in) :: s_parent, s_child + real, intent(in) :: ds_parent, ds_child +!--------------------------------------------------------------------------------------------------- + integer :: np ! Length of parent array + integer :: nc ! Length of child array +! + np = indmax - indmin + 1 + nc = ub_child - lb_child + 1 +! + if ( type_update == Agrif_Update_Copy ) then +! + call Agrif_basicupdate_copy1d( & + parent_tab, child_tab, & + np, nc, & + s_parent, s_child, & + ds_parent, ds_child ) +! + elseif ( type_update == Agrif_Update_Average ) then +! + call Agrif_basicupdate_average1d( & + parent_tab, child_tab, & + np, nc, & + s_parent, s_child, & + ds_parent, ds_child ) +! + elseif ( type_update == Agrif_Update_Full_Weighting ) then +! + call Agrif_basicupdate_full_weighting1D( & + parent_tab, child_tab, & + np, nc, & + s_parent, s_child, & + ds_parent, ds_child ) +! + endif +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_UpdateBase +!=================================================================================================== +! +#if defined AGRIF_MPI +!=================================================================================================== +! subroutine Agrif_Find_list_update +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Find_list_update ( list_update, pttab, petab, lb_child, lb_parent, nbdim, & + find_list_update, tab4t, tab5t, memberinall, memberinall2, & + sendtoproc1, recvfromproc1, sendtoproc2, recvfromproc2 ) +!--------------------------------------------------------------------------------------------------- + TYPE(Agrif_List_Interp_Loc), pointer :: list_update + INTEGER, intent(in) :: nbdim + INTEGER, DIMENSION(nbdim), intent(in) :: pttab, petab + INTEGER, DIMENSION(nbdim), intent(in) :: lb_child, lb_parent + LOGICAL, intent(out) :: find_list_update + INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1,8), intent(out) :: tab4t + INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1,8), intent(out) :: tab5t + LOGICAL, DIMENSION(0:Agrif_Nbprocs-1), intent(out) :: memberinall,memberinall2 + LOGICAL, DIMENSION(0:Agrif_Nbprocs-1), intent(out) :: sendtoproc1,recvfromproc1 + LOGICAL, DIMENSION(0:Agrif_Nbprocs-1), intent(out) :: sendtoproc2,recvfromproc2 +! + Type(Agrif_List_Interp_Loc), Pointer :: parcours + INTEGER :: i +! + find_list_update = .FALSE. +! + parcours => list_update + + Find_loop : do while ( associated(parcours) ) + do i = 1,nbdim + IF ((pttab(i) /= parcours%interp_loc%pttab(i)) .OR. & + (petab(i) /= parcours%interp_loc%petab(i)) .OR. & + (lb_child(i) /= parcours%interp_loc%pttab_child(i)) .OR. & + (lb_parent(i) /= parcours%interp_loc%pttab_parent(i))) THEN + parcours => parcours%suiv + cycle Find_loop + ENDIF + enddo +! + tab4t = parcours%interp_loc%tab4t(1:nbdim,0:Agrif_Nbprocs-1,1:8) + tab5t = parcours%interp_loc%tab5t(1:nbdim,0:Agrif_Nbprocs-1,1:8) + memberinall = parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1) + memberinall2 = parcours%interp_loc%memberinall2(0:Agrif_Nbprocs-1) + sendtoproc1 = parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1) + sendtoproc2 = parcours%interp_loc%sendtoproc2(0:Agrif_Nbprocs-1) + recvfromproc1 = parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1) + recvfromproc2 = parcours%interp_loc%recvfromproc2(0:Agrif_Nbprocs-1) +! + find_list_update = .TRUE. + exit Find_loop +! + enddo Find_loop +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Find_list_update +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_AddTo_list_update +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_AddTo_list_update ( list_update, pttab, petab, lb_child, lb_parent, & + nbdim, tab4t, tab5t, memberinall, memberinall2, & + sendtoproc1, recvfromproc1, sendtoproc2, recvfromproc2 ) +!--------------------------------------------------------------------------------------------------- + TYPE(Agrif_List_Interp_Loc), pointer :: list_update + INTEGER, intent(in) :: nbdim + INTEGER, DIMENSION(nbdim), intent(in) :: pttab, petab + INTEGER, DIMENSION(nbdim), intent(in) :: lb_child, lb_parent + INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1,8), intent(in) :: tab4t + INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1,8), intent(in) :: tab5t + LOGICAL, DIMENSION(0:Agrif_Nbprocs-1), intent(in) :: memberinall, memberinall2 + LOGICAL, DIMENSION(0:Agrif_Nbprocs-1), intent(in) :: sendtoproc1, recvfromproc1 + LOGICAL, DIMENSION(0:Agrif_Nbprocs-1), intent(in) :: sendtoproc2, recvfromproc2 +! + Type(Agrif_List_Interp_Loc), pointer :: parcours +! + allocate(parcours) + allocate(parcours%interp_loc) + + parcours%interp_loc%pttab(1:nbdim) = pttab(1:nbdim) + parcours%interp_loc%petab(1:nbdim) = petab(1:nbdim) + parcours%interp_loc%pttab_child(1:nbdim) = lb_child(1:nbdim) + parcours%interp_loc%pttab_parent(1:nbdim) = lb_parent(1:nbdim) + + allocate(parcours%interp_loc%tab4t(nbdim,0:Agrif_Nbprocs-1,8)) + allocate(parcours%interp_loc%tab5t(nbdim,0:Agrif_Nbprocs-1,8)) + + allocate(parcours%interp_loc%memberinall (0:Agrif_Nbprocs-1)) + allocate(parcours%interp_loc%memberinall2(0:Agrif_Nbprocs-1)) + + allocate(parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1)) + allocate(parcours%interp_loc%recvfromproc2(0:Agrif_Nbprocs-1)) + allocate(parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1)) + allocate(parcours%interp_loc%sendtoproc2(0:Agrif_Nbprocs-1)) + + parcours%interp_loc%tab4t = tab4t + parcours%interp_loc%tab5t = tab5t + parcours%interp_loc%memberinall = memberinall + parcours%interp_loc%memberinall2 = memberinall2 + parcours%interp_loc%sendtoproc1 = sendtoproc1 + parcours%interp_loc%sendtoproc2 = sendtoproc2 + parcours%interp_loc%recvfromproc1 = recvfromproc1 + parcours%interp_loc%recvfromproc2 = recvfromproc2 + + parcours%suiv => list_update + list_update => parcours +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Addto_list_update +!=================================================================================================== +#endif +! +end module Agrif_Update diff --git a/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modupdatebasic.F90 b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modupdatebasic.F90 new file mode 100644 index 00000000..41e8681e --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modupdatebasic.F90 @@ -0,0 +1,434 @@ +! +! $Id: modupdatebasic.F 779 2007-12-22 17:04:17Z rblod $ +! +! AGRIF (Adaptive Grid Refinement In Fortran) +! +! Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr) +! Christophe Vouland (Christophe.Vouland@imag.fr) +! +! This program is free software; you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation; either version 2 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program; if not, write to the Free Software +! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +! +! +! +!> Module containing different procedures of update (copy, average, full_weighting) +!! used in the #Agrif_Update module. +!=================================================================================================== +! +module Agrif_UpdateBasic +! + use Agrif_Types + + implicit none + + integer, dimension(:,:), allocatable :: indchildcopy + integer, dimension(:,:), allocatable :: indchildaverage +! +contains +! +!=================================================================================================== +! subroutine Agrif_basicupdate_copy1d +! +!> Carries out a copy on a parent grid (vector x) from its child grid (vector y). +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_basicupdate_copy1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child ) +!--------------------------------------------------------------------------------------------------- + real, dimension(np), intent(out) :: x !< Coarse output data to parent + real, dimension(nc), intent(in) :: y !< Fine input data from child + integer, intent(in) :: np !< Length of parent array + integer, intent(in) :: nc !< Length of child array + real, intent(in) :: s_parent !< Parent grid position (s_root = 0) + real, intent(in) :: s_child !< Child grid position (s_root = 0) + real, intent(in) :: ds_parent !< Parent grid dx (ds_root = 1) + real, intent(in) :: ds_child !< Child grid dx (ds_root = 1) +!--------------------------------------------------------------------------------------------------- + integer :: i, locind_child_left, coeffraf +! + coeffraf = nint(ds_parent/ds_child) + locind_child_left = 1 + nint((s_parent - s_child)/ds_child) +! + if ( coeffraf == 1 ) then +!CDIR ALTCODE + x(1:np) = y(locind_child_left:locind_child_left+np-1) + return + endif +! +!CDIR ALTCODE + do i = 1,np + x(i) = y(locind_child_left) + locind_child_left = locind_child_left + coeffraf + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_basicupdate_copy1d +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_basicupdate_copy1d_before +! +!> Precomputes index for a copy on a parent grid (vector x) from its child grid (vector y). +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_basicupdate_copy1d_before ( nc2, np, nc, s_parent, s_child, ds_parent, ds_child, dir ) +!--------------------------------------------------------------------------------------------------- + integer, intent(in) :: nc2 !< Length of parent array + integer, intent(in) :: np !< Length of parent array + integer, intent(in) :: nc !< Length of child array + real, intent(in) :: s_parent !< Parent grid position (s_root = 0) + real, intent(in) :: s_child !< Child grid position (s_root = 0) + real, intent(in) :: ds_parent !< Parent grid dx (ds_root = 1) + real, intent(in) :: ds_child !< Child grid dx (ds_root = 1) + integer, intent(in) :: dir !< Direction +!--------------------------------------------------------------------------------------------------- + integer, dimension(:,:), allocatable :: indchildcopy_tmp + integer :: i, n_old, locind_child_left, coeffraf +! + coeffraf = nint(ds_parent/ds_child) +! + locind_child_left = 1 + nint((s_parent - s_child)/ds_child) + + if ( .not.allocated(indchildcopy) ) then + allocate(indchildcopy(np*nc2, 3)) + else + n_old = size(indchildcopy,1) + if ( n_old < np*nc2 ) then + allocate( indchildcopy_tmp(1:n_old, 3)) + indchildcopy_tmp = indchildcopy + deallocate(indchildcopy) + allocate(indchildcopy(np*nc2, 3)) + indchildcopy(1:n_old,:) = indchildcopy_tmp + deallocate(indchildcopy_tmp) + endif + endif +! + do i = 1,np + indchildcopy(i,dir) = locind_child_left + locind_child_left = locind_child_left + coeffraf + enddo +! + do i = 2,nc2 + indchildcopy(1+(i-1)*np:i*np,dir) = indchildcopy(1+(i-2)*np:(i-1)*np,dir) + nc + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_basicupdate_copy1d_before +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_basicupdate_copy1d_after +! +!> Carries out a copy on a parent grid (vector x) from its child grid (vector y) +!! using precomputed index. +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_basicupdate_copy1d_after ( x, y, np, nc, dir ) +!--------------------------------------------------------------------------------------------------- + real, dimension(np), intent(out) :: x !< Coarse output data to parent + real, dimension(nc), intent(in) :: y !< Fine input data from child + integer, intent(in) :: np !< Length of parent array + integer, intent(in) :: nc !< Length of child array + integer, intent(in) :: dir !< Direction +!--------------------------------------------------------------------------------------------------- + integer :: i +! +!CDIR ALTCODE + do i = 1,np + x(i) = y(indchildcopy(i,dir)) + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_basicupdate_copy1d_after +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_basicupdate_average1d +! +!> Carries out an update by average on a parent grid (vector x)from its child grid (vector y). +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_basicupdate_average1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child ) +!--------------------------------------------------------------------------------------------------- + REAL, DIMENSION(np), intent(out) :: x + REAL, DIMENSION(nc), intent(in) :: y + INTEGER, intent(in) :: np,nc + REAL, intent(in) :: s_parent, s_child + REAL, intent(in) :: ds_parent, ds_child +! + INTEGER :: i, ii, locind_child_left, coeffraf + REAL :: xpos, invcoeffraf + INTEGER :: nbnonnuls + INTEGER :: diffmod +! + coeffraf = nint(ds_parent/ds_child) + invcoeffraf = 1./coeffraf +! + if (coeffraf == 1) then + locind_child_left = 1 + nint((s_parent - s_child)/ds_child) + x(1:np) = y(locind_child_left:locind_child_left+np-1) + return + endif +! + xpos = s_parent + x = 0. +! + diffmod = 0 +! + IF ( mod(coeffraf,2) == 0 ) diffmod = 1 +! + locind_child_left = 1 + agrif_int((xpos - s_child)/ds_child) +! + IF (Agrif_UseSpecialValueInUpdate) THEN + do i = 1,np + nbnonnuls = 0 +!CDIR NOVECTOR + do ii = -coeffraf/2+locind_child_left+diffmod, & + coeffraf/2+locind_child_left + IF (y(ii) /= Agrif_SpecialValueFineGrid) THEN +! nbnonnuls = nbnonnuls + 1 + x(i) = x(i) + y(ii) + ENDIF + enddo +! IF (nbnonnuls /= 0) THEN +! x(i) = x(i)/nbnonnuls +! ELSE +! x(i) = Agrif_SpecialValueFineGrid +! ENDIF + locind_child_left = locind_child_left + coeffraf + enddo + ELSE +! +!CDIR ALTCODE + do i = 1,np +!CDIR NOVECTOR + do ii = -coeffraf/2+locind_child_left+diffmod, & + coeffraf/2+locind_child_left + x(i) = x(i) + y(ii) + enddo +! x(i) = x(i)*invcoeffraf + locind_child_left = locind_child_left + coeffraf + enddo + IF (.not.Agrif_Update_Weights) THEN + x = x * invcoeffraf + ENDIF + ENDIF +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_basicupdate_average1d +!=================================================================================================== +! +!=================================================================================================== +! subroutine Average1dPrecompute +! +!> Carries out an update by average on a parent grid (vector x)from its child grid (vector y). +!--------------------------------------------------------------------------------------------------- +subroutine Average1dPrecompute ( nc2, np, nc, s_parent, s_child, ds_parent, ds_child, dir ) +!--------------------------------------------------------------------------------------------------- + INTEGER, intent(in) :: nc2, np, nc + REAL, intent(in) :: s_parent, s_child + REAL, intent(in) :: ds_parent, ds_child + INTEGER, intent(in) :: dir +! + INTEGER, DIMENSION(:,:), ALLOCATABLE :: indchildaverage_tmp + INTEGER :: i, locind_child_left, coeffraf + REAL :: xpos + INTEGER :: diffmod +! + coeffraf = nint(ds_parent/ds_child) + xpos = s_parent + diffmod = 0 +! + IF ( mod(coeffraf,2) == 0 ) diffmod = 1 +! + locind_child_left = 1 + agrif_int((xpos - s_child)/ds_child) +! + if (.not.allocated(indchildaverage)) then + allocate(indchildaverage(np*nc2,3)) + else + if (size(indchildaverage,1) Carries out an update by average on a parent grid (vector x) from its child grid (vector y). +!--------------------------------------------------------------------------------------------------- +subroutine Average1dAfterCompute ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child, dir ) +!--------------------------------------------------------------------------------------------------- + REAL, DIMENSION(np), intent(inout) :: x + REAL, DIMENSION(nc), intent(in) :: y + INTEGER, intent(in) :: np, nc + REAL, intent(in) :: s_parent, s_child + REAL, intent(in) :: ds_parent, ds_child + INTEGER, intent(in) :: dir +! + REAL :: invcoeffraf + INTEGER :: i, j, coeffraf + INTEGER, DIMENSION(np) :: nbnonnuls + REAL, DIMENSION(0:7), parameter :: invcoeff = (/1.,1.,0.5,1./3.,0.25,0.2,1./6.,1./7./) +! + coeffraf = nint(ds_parent/ds_child) + invcoeffraf = 1./coeffraf +! + IF (Agrif_UseSpecialValueInUpdate) THEN +! +! nbnonnuls = 0 + do j = 1,coeffraf + do i = 1,np + IF (y(indchildaverage(i,dir) + j -1) /= Agrif_SpecialValueFineGrid) THEN +! nbnonnuls(i) = nbnonnuls(i) + 1 + x(i) = x(i) + y(indchildaverage(i,dir) + j-1 ) + ENDIF + enddo + enddo + do i=1,np + ! x(i) = x(i)*invcoeff(nbnonnuls(i)) + ! if (nbnonnuls(i) == 0) x(i) = Agrif_SpecialValueFineGrid + enddo +! + ELSE +! +!CDIR NOLOOPCHG + do j = 1,coeffraf +!CDIR VECTOR + do i= 1,np + x(i) = x(i) + y(indchildaverage(i,dir) + j-1 ) + enddo + enddo + IF (.not.Agrif_Update_Weights) THEN + x = x * invcoeffraf + ENDIF +! + ENDIF + +!--------------------------------------------------------------------------------------------------- +end subroutine Average1dAfterCompute +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_basicupdate_full_weighting1D +! +!> Carries out an update by full_weighting on a parent grid (vector x) from its child grid (vector y). +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_basicupdate_full_weighting1D ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child ) +!--------------------------------------------------------------------------------------------------- + real, dimension(np), intent(out) :: x + real, dimension(nc), intent(in) :: y + integer, intent(in) :: np, nc + real, intent(in) :: s_parent, s_child + real, intent(in) :: ds_parent, ds_child +!--------------------------------------------------------------------------------------------------- + REAL :: xpos, xposfin + INTEGER :: i, ii, diffmod + INTEGER :: it1, it2 + INTEGER :: i1, i2 + INTEGER :: coeffraf + INTEGER :: locind_child_left + REAL :: sumweight, invsumweight + REAL :: weights(-Agrif_MaxRaff:Agrif_MaxRaff) + + coeffraf = nint(ds_parent/ds_child) + locind_child_left = 1 + agrif_int((s_parent-s_child)/ds_child) +! + if (coeffraf == 1) then + x(1:np) = y(locind_child_left:locind_child_left+np-1) + return + endif +! + xpos = s_parent + x = 0. +! + xposfin = s_child + ds_child * (locind_child_left - 1) + IF (abs(xposfin - xpos) < 0.001) THEN + diffmod = 0 + ELSE + diffmod = 1 + ENDIF +! + if (diffmod == 1) THEN + invsumweight=1./(2.*coeffraf**2) + do i = -coeffraf,-1 + weights(i) = invsumweight*(2*(coeffraf+i)+1) + enddo + do i = 0,coeffraf-1 + weights(i) = weights(-(i+1)) + enddo + it1 = -coeffraf + i1 = -(coeffraf-1)+locind_child_left + i2 = 2*coeffraf - 1 + + else + invsumweight=1./coeffraf**2 + do i = -(coeffraf-1),0 + weights(i) = invsumweight*(coeffraf + i) + enddo + do i=1,coeffraf-1 + weights(i) = invsumweight*(coeffraf - i) + enddo + it1 = -(coeffraf-1) + i1 = -(coeffraf-1)+locind_child_left + i2 = 2*coeffraf - 2 + + endif +! + sumweight = 0. + MYLOOP : do i = 1,np +! + it2 = it1 + +! sumweight = 0. + + do ii = i1,i1+i2 +! + IF (Agrif_UseSpecialValueInUpdate) THEN + IF (y(ii) /= Agrif_SpecialValueFineGrid) THEN + x(i) = x(i) + weights(it2)*y(ii) +! sumweight = sumweight+weights(it2) + ELSE + x(i) = Agrif_SpecialValueFineGrid + i1=i1+coeffraf + CYCLE MYLOOP + ENDIF + ELSE + x(i) = x(i) + weights(it2)*y(ii) + ENDIF + + it2 = it2+1 +! + enddo +! + i1 = i1 + coeffraf +! + enddo MYLOOP + + IF (Agrif_UseSpecialValueInUpdate) THEN + x = x * coeffraf ! x will be divided by coeffraf later in modupdate.F90 + ENDIF + +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_basicupdate_full_weighting1D +!=================================================================================================== +! +end module Agrif_UpdateBasic diff --git a/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modutil.F90 b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modutil.F90 new file mode 100644 index 00000000..45afed92 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modutil.F90 @@ -0,0 +1,1150 @@ +! +! $Id: modutil.F 662 2007-05-25 15:58:52Z opalod $ +! +! Agrif (Adaptive Grid Refinement In Fortran) +! +! Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr) +! Christophe Vouland (Christophe.Vouland@imag.fr) +! +! This program is free software; you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation; either version 2 of the License, or +! (at your option) any later version. +! +! This program is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program; if not, write to the Free Software +! Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA. +! +!> Module Agrif_Util +!! +!! This module contains the two procedures called in the main program : +!! - #Agrif_Init_Grids allows the initialization of the root coarse grid +!! - #Agrif_Step allows the creation of the grid hierarchy and the management of the time integration. +! +module Agrif_Util +! + use Agrif_Clustering + use Agrif_BcFunction + use Agrif_seq +! + implicit none +! + abstract interface + subroutine step_proc() + end subroutine step_proc + end interface +! +contains +! +!=================================================================================================== +! subroutine Agrif_Step +! +!> Creates the grid hierarchy and manages the time integration procedure. +!> It is called in the main program. +!> Calls subroutines #Agrif_Regrid and #Agrif_Integrate. +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Step ( procname ) +!--------------------------------------------------------------------------------------------------- + procedure(step_proc) :: procname !< subroutine to call on each grid + type(agrif_grid), pointer :: ref_grid +! +! Set the clustering variables + call Agrif_clustering_def() +! +! Creation and initialization of the grid hierarchy + if ( Agrif_USE_ONLY_FIXED_GRIDS == 1 ) then +! + if ( (Agrif_Mygrid % ngridstep == 0) .AND. (.not. Agrif_regrid_has_been_done) ) then + call Agrif_Regrid() + Agrif_regrid_has_been_done = .TRUE. + endif +! + else +! + if (mod(Agrif_Mygrid % ngridstep,Agrif_Regridding) == 0) then + call Agrif_Regrid() + endif +! + endif +! +! Time integration of the grid hierarchy + if (agrif_coarse) then + ref_grid => agrif_coarsegrid + else + ref_grid => agrif_mygrid + endif + if ( Agrif_Parallel_sisters ) then + call Agrif_Integrate_Parallel(ref_grid,procname) + else + call Agrif_Integrate(ref_grid,procname) + endif +! + if ( ref_grid%child_list%nitems > 0 ) call Agrif_Instance(ref_grid) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Step +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Step_Child +! +!> Apply 'procname' to each grid of the hierarchy +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Step_Child ( procname ) +!--------------------------------------------------------------------------------------------------- + procedure(step_proc) :: procname !< subroutine to call on each grid +! + if ( Agrif_Parallel_sisters ) then + call Agrif_Integrate_Child_Parallel(Agrif_Mygrid,procname) + else + call Agrif_Integrate_Child(Agrif_Mygrid,procname) + endif +! + if ( Agrif_Mygrid%child_list%nitems > 0 ) call Agrif_Instance(Agrif_Mygrid) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Step_Child +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Step_Childs +! +!> Apply 'procname' to each child grids of the current grid +!--------------------------------------------------------------------------------------------------- +! ************************************************************************** +!!! Subroutine Agrif_Step_Childs +! ************************************************************************** +! + Subroutine Agrif_Step_Childs(procname) +! + procedure(step_proc) :: procname !< subroutine to call on each grid +! Pointer argument + Type(Agrif_Grid),pointer :: g ! Pointer on the current grid +! + +! +! Local pointer + Type(Agrif_pgrid),pointer :: parcours ! Pointer for the recursive + ! procedure +! + g => Agrif_Curgrid + + parcours => g % child_list % first +! +! Recursive procedure for the time integration of the grid hierarchy + Do while (associated(parcours)) +! +! Instanciation of the variables of the current grid + Call Agrif_Instance(parcours % gr) + +! One step on the current grid + + Call procname () + parcours => parcours % next + enddo + + If (associated(g % child_list % first)) Call Agrif_Instance (g) + Return + End Subroutine Agrif_Step_Childs +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Regrid +! +!> Creates the grid hierarchy from fixed grids and adaptive mesh refinement. +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Regrid ( procname ) +!--------------------------------------------------------------------------------------------------- + procedure(init_proc), optional :: procname !< Initialisation subroutine (Default: Agrif_InitValues) +! + type(Agrif_Rectangle), pointer :: coarsegrid_fixed + type(Agrif_Rectangle), pointer :: coarsegrid_moving + integer :: i, j + integer :: nunit + logical :: BEXIST + TYPE(Agrif_Rectangle) :: newrect ! Pointer on a new grid + integer :: is_coarse, rhox, rhoy, rhoz, rhot +! + if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) & + call Agrif_detect_all(Agrif_Mygrid) ! Detection of areas to be refined +! + allocate(coarsegrid_fixed) + allocate(coarsegrid_moving) +! + if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) & + call Agrif_Cluster_All(Agrif_Mygrid,coarsegrid_moving) ! Clustering +! + if ( Agrif_USE_FIXED_GRIDS == 1 .OR. Agrif_USE_ONLY_FIXED_GRIDS == 1 ) then +! + if (Agrif_Mygrid % ngridstep == 0) then +! + nunit = Agrif_Get_Unit() + open(nunit, file='AGRIF_FixedGrids.in', form='formatted', status="old", ERR=99) + if (agrif_coarse) then ! SKIP the coarse grid declaration + if (Agrif_Probdim == 3) then + read(nunit,*) is_coarse, rhox, rhoy, rhoz, rhot + elseif (Agrif_Probdim == 2) then + read(nunit,*) is_coarse, rhox, rhoy, rhot + elseif (Agrif_Probdim == 2) then + read(nunit,*) is_coarse, rhox, rhot + endif + endif +! Creation of the grid hierarchy from the Agrif_FixedGrids.in file + do i = 1,Agrif_Probdim + coarsegrid_fixed % imin(i) = 1 + coarsegrid_fixed % imax(i) = Agrif_Mygrid % nb(i) + 1 + enddo + j = 1 + call Agrif_Read_Fix_Grd(coarsegrid_fixed,j,nunit) + close(nunit) +! + call Agrif_gl_clear(Agrif_oldmygrid) +! +! Creation of the grid hierarchy from coarsegrid_fixed + call Agrif_Create_Grids(Agrif_Mygrid,coarsegrid_fixed) + + else + call Agrif_gl_copy(Agrif_oldmygrid, Agrif_Mygrid % child_list) + endif + else + call Agrif_gl_copy(Agrif_oldmygrid, Agrif_Mygrid % child_list) + call Agrif_gl_clear(Agrif_Mygrid % child_list) + endif +! + if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) then +! + call Agrif_Save_All(Agrif_oldmygrid) + call Agrif_Free_before_All(Agrif_oldmygrid) +! +! Creation of the grid hierarchy from coarsegrid_moving + call Agrif_Create_Grids(Agrif_Mygrid,coarsegrid_moving) +! + endif +! +! Initialization of the grid hierarchy by copy or interpolation +! +#if defined AGRIF_MPI + if ( Agrif_Parallel_sisters ) then + call Agrif_Init_Hierarchy_Parallel_1(Agrif_Mygrid) + call Agrif_Init_Hierarchy_Parallel_2(Agrif_Mygrid,procname) + else + call Agrif_Init_Hierarchy(Agrif_Mygrid,procname) + endif +#else + call Agrif_Init_Hierarchy(Agrif_Mygrid,procname) +#endif +! + if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) call Agrif_Free_after_All(Agrif_oldmygrid) +! + Agrif_regrid_has_been_done = .TRUE. +! + call Agrif_Instance( Agrif_Mygrid ) +! + deallocate(coarsegrid_fixed) + deallocate(coarsegrid_moving) +! + return +! +! Opening error +! +99 INQUIRE(FILE='AGRIF_FixedGrids.in',EXIST=BEXIST) + if (.not. BEXIST) then + print*,'ERROR : File AGRIF_FixedGrids.in not found.' + STOP + else + print*,'Error opening file AGRIF_FixedGrids.in' + STOP + endif +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Regrid +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_detect_All +! +!> Detects areas to be refined. +!--------------------------------------------------------------------------------------------------- +recursive subroutine Agrif_detect_all ( g ) +!--------------------------------------------------------------------------------------------------- + TYPE(Agrif_Grid), pointer :: g !< Pointer on the current grid +! + Type(Agrif_PGrid), pointer :: parcours ! Pointer for the recursive procedure + integer, DIMENSION(3) :: size + integer :: i + real :: g_eps +! + parcours => g % child_list % first +! +! To be positioned on the finer grids of the grid hierarchy +! + do while (associated(parcours)) + call Agrif_detect_all(parcours % gr) + parcours => parcours % next + enddo +! + g_eps = huge(1.) + do i = 1,Agrif_Probdim + g_eps = min(g_eps, g % Agrif_dx(i)) + enddo +! + g_eps = g_eps / 100. +! + if ( Agrif_Probdim == 1 ) g%tabpoint1D = 0 + if ( Agrif_Probdim == 2 ) g%tabpoint2D = 0 + if ( Agrif_Probdim == 3 ) g%tabpoint3D = 0 +! + do i = 1,Agrif_Probdim + if ( g%Agrif_dx(i)/Agrif_coeffref(i) < (Agrif_mind(i)-g_eps) ) return + enddo +! + call Agrif_instance(g) +! +! Detection (Agrif_detect is a users routine) +! + do i = 1,Agrif_Probdim + size(i) = g % nb(i) + 1 + enddo +! + SELECT CASE (Agrif_Probdim) + CASE (1) + call Agrif_detect(g%tabpoint1D,size) + CASE (2) + call Agrif_detect(g%tabpoint2D,size) + CASE (3) + call Agrif_detect(g%tabpoint3D,size) + END SELECT +! +! Addition of the areas detected on the child grids +! + parcours => g % child_list % first +! + do while (associated(parcours)) + call Agrif_Add_detected_areas(g,parcours % gr) + parcours => parcours % next + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_detect_all +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Add_detected_areas +! +!> Adds on the parent grid the areas detected on its child grids +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Add_detected_areas ( parentgrid, childgrid ) +!--------------------------------------------------------------------------------------------------- + Type(Agrif_Grid), pointer :: parentgrid + Type(Agrif_Grid), pointer :: childgrid +! + integer :: i,j,k +! + do i = 1,childgrid%nb(1)+1 + if ( Agrif_Probdim == 1 ) then + if (childgrid%tabpoint1D(i)==1) then + parentgrid%tabpoint1D(childgrid%ix(1)+(i-1)/Agrif_Coeffref(1)) = 1 + endif + else + do j=1,childgrid%nb(2)+1 + if (Agrif_Probdim==2) then + if (childgrid%tabpoint2D(i,j)==1) then + parentgrid%tabpoint2D( & + childgrid%ix(1)+(i-1)/Agrif_Coeffref(1), & + childgrid%ix(2)+(j-1)/Agrif_Coeffref(2)) = 1 + endif + else + do k=1,childgrid%nb(3)+1 + if (childgrid%tabpoint3D(i,j,k)==1) then + parentgrid%tabpoint3D( & + childgrid%ix(1)+(i-1)/Agrif_Coeffref(1), & + childgrid%ix(2)+(j-1)/Agrif_Coeffref(2), & + childgrid%ix(3)+(k-1)/Agrif_Coeffref(3)) = 1 + endif + enddo + endif + enddo + endif + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Add_detected_areas +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Free_before_All +!--------------------------------------------------------------------------------------------------- +recursive subroutine Agrif_Free_before_All ( gridlist ) +!--------------------------------------------------------------------------------------------------- + Type(Agrif_Grid_List), intent(inout) :: gridlist !< Grid list +! + Type(Agrif_PGrid), pointer :: parcours ! Pointer for the recursive procedure +! + parcours => gridlist % first +! + do while (associated(parcours)) +! + if (.not. parcours%gr%fixed) then + call Agrif_Free_data_before(parcours%gr) + parcours % gr % oldgrid = .TRUE. + endif +! + call Agrif_Free_before_all (parcours % gr % child_list) +! + parcours => parcours % next +! + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Free_before_All +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Save_All +!--------------------------------------------------------------------------------------------------- +recursive subroutine Agrif_Save_All ( gridlist ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid_List), intent(inout) :: gridlist !< Grid list +! + type(Agrif_PGrid), pointer :: parcours ! Pointer for the recursive procedure +! + parcours => gridlist % first +! + do while (associated(parcours)) +! + if (.not. parcours%gr%fixed) then + call Agrif_Instance(parcours%gr) + call Agrif_Before_Regridding() + parcours % gr % oldgrid = .TRUE. + endif +! + call Agrif_Save_All(parcours % gr % child_list) +! + parcours => parcours % next +! + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Save_All +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Free_after_All +!--------------------------------------------------------------------------------------------------- +recursive subroutine Agrif_Free_after_All ( gridlist ) +!--------------------------------------------------------------------------------------------------- + Type(Agrif_Grid_List), intent(inout) :: gridlist !< Grid list to free +! + Type(Agrif_PGrid), pointer :: parcours ! Pointer for the recursive proced + Type(Agrif_PGrid), pointer :: preparcours + Type(Agrif_PGrid), pointer :: preparcoursini +! + allocate(preparcours) +! + preparcoursini => preparcours +! + nullify(preparcours % gr) +! + preparcours % next => gridlist % first + parcours => gridlist % first +! + do while (associated(parcours)) +! + if ( (.NOT. parcours%gr % fixed) .AND. (parcours%gr % oldgrid) ) then + call Agrif_Free_data_after(parcours%gr) + endif +! + call Agrif_Free_after_all( parcours%gr % child_list ) +! + if (parcours % gr % oldgrid) then + deallocate(parcours % gr) + preparcours % next => parcours % next + deallocate(parcours) + parcours => preparcours % next + else + preparcours => preparcours % next + parcours => parcours % next + endif +! + enddo +! + deallocate(preparcoursini) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Free_after_All +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Integrate +! +!> Manages the time integration of the grid hierarchy. +!! Recursive subroutine and call on subroutines Agrif_Init::Agrif_Instance and #Agrif_Step +!--------------------------------------------------------------------------------------------------- +recursive subroutine Agrif_Integrate ( g, procname ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid), pointer :: g !< Pointer on the current grid + procedure(step_proc) :: procname !< Subroutine to call on each grid +! + type(Agrif_PGrid), pointer :: parcours ! Pointer for the recursive procedure + integer :: nbt ! Number of time steps of the current grid + integer :: i, k +! +! Instanciation of the variables of the current grid +! if ( g % fixedrank /= 0 ) then + call Agrif_Instance(g) +! endif +! +! One step on the current grid +! + call procname () +! +! Number of time steps on the current grid +! + g%ngridstep = g % ngridstep + 1 + parcours => g % child_list % first +! +! Recursive procedure for the time integration of the grid hierarchy + do while (associated(parcours)) +! +! Instanciation of the variables of the current grid + call Agrif_Instance(parcours % gr) +! +! Number of time steps + nbt = 1 + do i = 1,Agrif_Probdim + nbt = max(nbt, parcours % gr % timeref(i)) + enddo +! + do k = 1,nbt + call Agrif_Integrate(parcours % gr, procname) + enddo +! + parcours => parcours % next +! + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Integrate +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Integrate_Parallel +! +!> Manages the time integration of the grid hierarchy in parallel +!! Recursive subroutine and call on subroutines Agrif_Init::Agrif_Instance and #Agrif_Step +!--------------------------------------------------------------------------------------------------- +recursive subroutine Agrif_Integrate_Parallel ( g, procname ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid), pointer :: g !< Pointer on the current grid + procedure(step_proc) :: procname !< Subroutine to call on each grid +! +#if defined AGRIF_MPI + type(Agrif_PGrid), pointer :: gridp ! Pointer for the recursive procedure + integer :: nbt ! Number of time steps of the current grid + integer :: i, k, is +! +! Instanciation of the variables of the current grid + if ( g % fixedrank /= 0 ) then + call Agrif_Instance(g) + endif +! +! One step on the current grid + call procname () +! +! Number of time steps on the current grid + g % ngridstep = g % ngridstep + 1 +! +! Continue only if the grid has defined sequences of child integrations. + if ( .not. associated(g % child_seq) ) return +! + do is = 1, g % child_seq % nb_seqs +! +! For each sequence, a given processor does integrate only on grid. + gridp => Agrif_seq_select_child(g,is) +! +! Instanciation of the variables of the current grid + call Agrif_Instance(gridp % gr) +! +! Number of time steps + nbt = 1 + do i = 1,Agrif_Probdim + nbt = max(nbt, gridp % gr % timeref(i)) + enddo +! + do k = 1,nbt + call Agrif_Integrate_Parallel(gridp % gr, procname) + enddo +! + enddo +#else + call Agrif_Integrate( g, procname ) +#endif +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Integrate_Parallel +!=================================================================================================== +! +!=================================================================================================== +! +! +!=================================================================================================== +! subroutine Agrif_Integrate_ChildGrids +! +!> Manages the time integration of the grid hierarchy. +!! Call the subroutine procname on each child grid of the current grid +!--------------------------------------------------------------------------------------------------- +recursive subroutine Agrif_Integrate_ChildGrids ( procname ) +!--------------------------------------------------------------------------------------------------- + procedure(step_proc) :: procname !< Subroutine to call on each grid +! + type(Agrif_PGrid), pointer :: parcours ! Pointer for the recursive procedure + integer :: nbt ! Number of time steps of the current grid + integer :: i, k, is + type(Agrif_Grid) , pointer :: save_grid + type(Agrif_PGrid), pointer :: gridp ! Pointer for the recursive procedure + + save_grid => Agrif_Curgrid + +! Number of time steps on the current grid + save_grid % ngridstep = save_grid % ngridstep + 1 + +#ifdef AGRIF_MPI + if ( .not. Agrif_Parallel_sisters ) then +#endif + parcours => save_grid % child_list % first +! +! Recursive procedure for the time integration of the grid hierarchy + do while (associated(parcours)) +! +! Instanciation of the variables of the current grid + call Agrif_Instance(parcours % gr) +! +! Number of time steps + nbt = 1 + do i = 1,Agrif_Probdim + nbt = max(nbt, parcours % gr % timeref(i)) + enddo +! + do k = 1,nbt + call procname() + enddo +! + parcours => parcours % next +! + enddo + +#ifdef AGRIF_MPI + else +! Continue only if the grid has defined sequences of child integrations. + if ( .not. associated(save_grid % child_seq) ) return +! + do is = 1, save_grid % child_seq % nb_seqs +! +! For each sequence, a given processor does integrate only on grid. + gridp => Agrif_seq_select_child(save_grid,is) +! +! Instanciation of the variables of the current grid + call Agrif_Instance(gridp % gr) +! +! Number of time steps + nbt = 1 + do i = 1,Agrif_Probdim + nbt = max(nbt, gridp % gr % timeref(i)) + enddo +! + do k = 1,nbt + call procname() + enddo +! + enddo + endif +#endif + + call Agrif_Instance(save_grid) + +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Integrate_ChildGrids +!=================================================================================================== +!=================================================================================================== +! subroutine Agrif_Integrate_Child +! +!> Manages the time integration of the grid hierarchy. +!! Recursive subroutine and call on subroutines Agrif_Instance & Agrif_Step. +!--------------------------------------------------------------------------------------------------- +recursive subroutine Agrif_Integrate_Child ( g, procname ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid), pointer :: g !< Pointer on the current grid + procedure(step_proc) :: procname !< Subroutine to call on each grid +! + type(Agrif_PGrid), pointer :: parcours ! Pointer for the recursive procedure +! +! One step on the current grid +! + call procname () +! +! Number of time steps on the current grid +! + parcours => g % child_list % first +! +! Recursive procedure for the time integration of the grid hierarchy + do while (associated(parcours)) +! +! Instanciation of the variables of the current grid + call Agrif_Instance(parcours % gr) + call Agrif_Integrate_Child (parcours % gr, procname) + parcours => parcours % next +! + enddo +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Integrate_Child +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Integrate_Child_Parallel +! +!> Manages the time integration of the grid hierarchy. +!! Recursive subroutine and call on subroutines Agrif_Instance & Agrif_Step. +!--------------------------------------------------------------------------------------------------- +recursive subroutine Agrif_Integrate_Child_Parallel ( g, procname ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid), pointer :: g !< Pointer on the current grid + procedure(step_proc) :: procname !< Subroutine to call on each grid +! +#if defined AGRIF_MPI + type(Agrif_PGrid), pointer :: gridp ! Pointer for the recursive procedure + integer :: is +! +! Instanciation of the variables of the current grid + call Agrif_Instance(g) +! +! One step on the current grid + call procname () +! +! Continue only if the grid has defined sequences of child integrations. + if ( .not. associated(g % child_seq) ) return +! + do is = 1, g % child_seq % nb_seqs +! +! For each sequence, a given processor does integrate only on grid. + gridp => Agrif_seq_select_child(g,is) + call Agrif_Integrate_Child_Parallel(gridp % gr, procname) +! + enddo +! + call Agrif_Instance(g) +#else + call Agrif_Integrate_Child( g, procname ) +#endif +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Integrate_Child_Parallel +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Init_Grids +! +!> Initializes the root coarse grid pointed by Agrif_Mygrid. It is called in the main program. +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Init_Grids ( procname1, procname2 ) +!--------------------------------------------------------------------------------------------------- + procedure(typedef_proc), optional :: procname1 !< (Default: Agrif_probdim_modtype_def) + procedure(alloc_proc), optional :: procname2 !< (Default: Agrif_Allocationcalls) +! + integer :: i, ierr_allocate, nunit + integer :: is_coarse, rhox,rhoy,rhoz,rhot + logical :: BEXIST +! + if (present(procname1)) Then + call procname1() + else + call Agrif_probdim_modtype_def() + endif +! + +! TEST FOR COARSE GRID (GRAND MOTHER GRID) in AGRIF_FixedGrids.in + nunit = Agrif_Get_Unit() + open(nunit, file='AGRIF_FixedGrids.in', form='formatted', status="old", ERR=98) + if (Agrif_Probdim == 3) then + read(nunit,*) is_coarse, rhox, rhoy, rhoz, rhot + elseif (Agrif_Probdim == 2) then + read(nunit,*) is_coarse, rhox, rhoy, rhot + elseif (Agrif_Probdim == 2) then + read(nunit,*) is_coarse, rhox, rhot + endif + if (is_coarse == -1) then + agrif_coarse = .TRUE. + if (Agrif_Probdim == 3) then + coarse_spaceref(1:3)=(/rhox,rhoy,rhoz/) + elseif (Agrif_Probdim == 2) then + coarse_spaceref(1:2)=(/rhox,rhoy/) + elseif (Agrif_Probdim == 2) then + coarse_spaceref(1:1)=(/rhox/) + endif + coarse_timeref(1:Agrif_Probdim) = rhot + endif + close(nunit) + + Agrif_UseSpecialValue = .FALSE. + Agrif_UseSpecialValueFineGrid = .FALSE. + Agrif_SpecialValue = 0. + Agrif_SpecialValueFineGrid = 0. +! + allocate(Agrif_Mygrid) + allocate(Agrif_OldMygrid) +! +! Space and time refinement factors are set to 1 on the root grid +! + do i = 1,Agrif_Probdim + Agrif_Mygrid % spaceref(i) = coarse_spaceref(i) + Agrif_Mygrid % timeref(i) = coarse_timeref(i) + enddo +! +! Initialization of the number of time steps + Agrif_Mygrid % ngridstep = 0 + Agrif_Mygrid % grid_id = 0 +! +! No parent grid for the root coarse grid + nullify(Agrif_Mygrid % parent) +! +! Initialization of the minimum positions, global abscissa and space steps + do i = 1, Agrif_Probdim + Agrif_Mygrid % ix(i) = 1 + Agrif_Mygrid % Agrif_x(i) = 0. + Agrif_Mygrid % Agrif_dx(i) = 1./Agrif_Mygrid % spaceref(i) + Agrif_Mygrid % Agrif_dt(i) = 1./Agrif_Mygrid % timeref(i) +! Borders of the root coarse grid + Agrif_Mygrid % NearRootBorder(i) = .true. + Agrif_Mygrid % DistantRootBorder(i) = .true. + enddo +! +! The root coarse grid is a fixed grid + Agrif_Mygrid % fixed = .TRUE. +! Level of the root grid + Agrif_Mygrid % level = 0 +! Maximum level in the hierarchy + Agrif_MaxLevelLoc = 0 +! +! Number of the grid pointed by Agrif_Mygrid (root coarse grid) + Agrif_Mygrid % rank = 1 +! +! Number of the root grid as a fixed grid + Agrif_Mygrid % fixedrank = 0 +! +! Initialization of some fields of the root grid variables + ierr_allocate = 0 + if( Agrif_NbVariables(0) > 0 ) allocate(Agrif_Mygrid % tabvars(Agrif_NbVariables(0)),stat=ierr_allocate) + if( Agrif_NbVariables(1) > 0 ) allocate(Agrif_Mygrid % tabvars_c(Agrif_NbVariables(1)),stat=ierr_allocate) + if( Agrif_NbVariables(2) > 0 ) allocate(Agrif_Mygrid % tabvars_r(Agrif_NbVariables(2)),stat=ierr_allocate) + if( Agrif_NbVariables(3) > 0 ) allocate(Agrif_Mygrid % tabvars_l(Agrif_NbVariables(3)),stat=ierr_allocate) + if( Agrif_NbVariables(4) > 0 ) allocate(Agrif_Mygrid % tabvars_i(Agrif_NbVariables(4)),stat=ierr_allocate) + if (ierr_allocate /= 0) THEN + STOP "*** ERROR WHEN ALLOCATING TABVARS ***" + endif +! +! Initialization of the other fields of the root grid variables (number of +! cells, positions, number and type of its dimensions, ...) + call Agrif_Instance(Agrif_Mygrid) + call Agrif_Set_numberofcells(Agrif_Mygrid) +! +! Allocation of the array containing the values of the grid variables + call Agrif_Allocation(Agrif_Mygrid, procname2) + call Agrif_initialisations(Agrif_Mygrid) +! +! Total number of fixed grids + Agrif_nbfixedgrids = 0 + +! If a grand mother grid is declared + + if (agrif_coarse) then + allocate(Agrif_Coarsegrid) + + Agrif_Coarsegrid % ngridstep = 0 + Agrif_Coarsegrid % grid_id = -9999 + + do i = 1, Agrif_Probdim + Agrif_Coarsegrid%spaceref(i) = coarse_spaceref(i) + Agrif_Coarsegrid%timeref(i) = coarse_timeref(i) + Agrif_Coarsegrid % ix(i) = 1 + Agrif_Coarsegrid % Agrif_x(i) = 0. + Agrif_Coarsegrid % Agrif_dx(i) = 1. + Agrif_Coarsegrid % Agrif_dt(i) = 1. +! Borders of the root coarse grid + Agrif_Coarsegrid % NearRootBorder(i) = .true. + Agrif_Coarsegrid % DistantRootBorder(i) = .true. + Agrif_Coarsegrid % nb(i) =Agrif_mygrid%nb(i) / coarse_spaceref(i) + enddo + +! The root coarse grid is a fixed grid + Agrif_Coarsegrid % fixed = .TRUE. +! Level of the root grid + Agrif_Coarsegrid % level = -1 + + Agrif_Coarsegrid % grand_mother_grid = .true. + +! Number of the grid pointed by Agrif_Mygrid (root coarse grid) + Agrif_Coarsegrid % rank = -9999 +! +! Number of the root grid as a fixed grid + Agrif_Coarsegrid % fixedrank = -9999 + + Agrif_Mygrid%parent => Agrif_Coarsegrid + +! Not used but required to prevent seg fault + Agrif_Coarsegrid%parent => Agrif_Mygrid + + call Agrif_Create_Var(Agrif_Coarsegrid) + +! Reset to null + Nullify(Agrif_Coarsegrid%parent) + + Agrif_Coarsegrid%child_list%nitems = 1 + allocate(Agrif_Coarsegrid%child_list%first) + allocate(Agrif_Coarsegrid%child_list%last) + Agrif_Coarsegrid%child_list%first%gr => Agrif_Mygrid + Agrif_Coarsegrid%child_list%last%gr => Agrif_Mygrid + + endif + + return + +98 INQUIRE(FILE='AGRIF_FixedGrids.in',EXIST=BEXIST) + if (.not. BEXIST) then + print*,'ERROR : File AGRIF_FixedGrids.in not found.' + STOP + else + print*,'Error opening file AGRIF_FixedGrids.in' + STOP + endif + +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Init_Grids +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Deallocation +! +!> Deallocates all data arrays. +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Deallocation +!--------------------------------------------------------------------------------------------------- + integer :: nb + type(Agrif_Variable), pointer :: var + type(Agrif_Variable_c), pointer :: var_c + type(Agrif_Variable_l), pointer :: var_l + type(Agrif_Variable_i), pointer :: var_i +! + do nb = 1,Agrif_NbVariables(0) +! + var => Agrif_Mygrid % tabvars(nb) +! + if ( allocated(var % array1) ) deallocate(var % array1) + if ( allocated(var % array2) ) deallocate(var % array2) + if ( allocated(var % array3) ) deallocate(var % array3) + if ( allocated(var % array4) ) deallocate(var % array4) + if ( allocated(var % array5) ) deallocate(var % array5) + if ( allocated(var % array6) ) deallocate(var % array6) +! + if ( allocated(var % sarray1) ) deallocate(var % sarray1) + if ( allocated(var % sarray2) ) deallocate(var % sarray2) + if ( allocated(var % sarray3) ) deallocate(var % sarray3) + if ( allocated(var % sarray4) ) deallocate(var % sarray4) + if ( allocated(var % sarray5) ) deallocate(var % sarray5) + if ( allocated(var % sarray6) ) deallocate(var % sarray6) +! + if ( allocated(var % darray1) ) deallocate(var % darray1) + if ( allocated(var % darray2) ) deallocate(var % darray2) + if ( allocated(var % darray3) ) deallocate(var % darray3) + if ( allocated(var % darray4) ) deallocate(var % darray4) + if ( allocated(var % darray5) ) deallocate(var % darray5) + if ( allocated(var % darray6) ) deallocate(var % darray6) +! + enddo +! + do nb = 1,Agrif_NbVariables(1) +! + var_c => Agrif_Mygrid % tabvars_c(nb) +! + if ( allocated(var_c % carray1) ) deallocate(var_c % carray1) + if ( allocated(var_c % carray2) ) deallocate(var_c % carray2) +! + enddo + + do nb = 1,Agrif_NbVariables(3) +! + var_l => Agrif_Mygrid % tabvars_l(nb) +! + if ( allocated(var_l % larray1) ) deallocate(var_l % larray1) + if ( allocated(var_l % larray2) ) deallocate(var_l % larray2) + if ( allocated(var_l % larray3) ) deallocate(var_l % larray3) + if ( allocated(var_l % larray4) ) deallocate(var_l % larray4) + if ( allocated(var_l % larray5) ) deallocate(var_l % larray5) + if ( allocated(var_l % larray6) ) deallocate(var_l % larray6) +! + enddo +! + do nb = 1,Agrif_NbVariables(4) +! + var_i => Agrif_Mygrid % tabvars_i(nb) +! + if ( allocated(var_i % iarray1) ) deallocate(var_i % iarray1) + if ( allocated(var_i % iarray2) ) deallocate(var_i % iarray2) + if ( allocated(var_i % iarray3) ) deallocate(var_i % iarray3) + if ( allocated(var_i % iarray4) ) deallocate(var_i % iarray4) + if ( allocated(var_i % iarray5) ) deallocate(var_i % iarray5) + if ( allocated(var_i % iarray6) ) deallocate(var_i % iarray6) +! + enddo +! + if ( allocated(Agrif_Mygrid % tabvars) ) deallocate(Agrif_Mygrid % tabvars) + if ( allocated(Agrif_Mygrid % tabvars_c) ) deallocate(Agrif_Mygrid % tabvars_c) + if ( allocated(Agrif_Mygrid % tabvars_r) ) deallocate(Agrif_Mygrid % tabvars_r) + if ( allocated(Agrif_Mygrid % tabvars_l) ) deallocate(Agrif_Mygrid % tabvars_l) + if ( allocated(Agrif_Mygrid % tabvars_i) ) deallocate(Agrif_Mygrid % tabvars_i) + deallocate(Agrif_Mygrid) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Deallocation +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Step_adj +! +!> creates the grid hierarchy and manages the backward time integration procedure. +!> It is called in the main program. +!> calls subroutines #Agrif_Regrid and #Agrif_Integrate_adj. +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Step_adj ( procname ) +!--------------------------------------------------------------------------------------------------- + procedure(step_proc) :: procname !< Subroutine to call on each grid +! +! Creation and initialization of the grid hierarchy +! +! Set the clustering variables + call Agrif_clustering_def() +! + if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 1 ) then +! + if (Agrif_Mygrid % ngridstep == 0) then + if (.not.Agrif_regrid_has_been_done ) then + call Agrif_Regrid() + endif + call Agrif_Instance(Agrif_Mygrid) + endif +! + else +! + if (mod(Agrif_Mygrid % ngridstep, Agrif_Regridding) == 0) then + call Agrif_Regrid() + call Agrif_Instance(Agrif_Mygrid) + endif +! + endif +! +! Time integration of the grid hierarchy +! + call Agrif_Integrate_adj (Agrif_Mygrid,procname) +! + if ( Agrif_Mygrid % child_list % nitems > 0 ) call Agrif_Instance(Agrif_Mygrid) +! +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Step_adj +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Integrate_adj +! +!> Manages the backward time integration of the grid hierarchy. +!! Recursive subroutine and call on subroutines Agrif_Init::Agrif_Instance and #Agrif_Step_adj +!--------------------------------------------------------------------------------------------------- +recursive subroutine Agrif_Integrate_adj ( g, procname ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid), pointer :: g !< Pointer on the current grid + procedure(step_proc) :: procname !< Subroutine to call on each grid +! + type(Agrif_pgrid), pointer :: parcours ! pointer for the recursive procedure + integer :: nbt ! Number of time steps of the current grid + integer :: k +! +! Instanciation of the variables of the current grid + if ( g%fixedrank /= 0 ) then + call Agrif_Instance(g) + endif +! +! Number of time steps on the current grid +! + g%ngridstep = g % ngridstep + 1 + parcours => g % child_list % first +! +! Recursive procedure for the time integration of the grid hierarchy + do while (associated(parcours)) +! +! Instanciation of the variables of the current grid + call Agrif_Instance(parcours % gr) +! +! Number of time steps + nbt = 1 + do k = 1,Agrif_Probdim + nbt = max(nbt, parcours % gr % timeref(k)) + enddo +! + do k = nbt,1,-1 + call Agrif_Integrate_adj(parcours % gr, procname) + enddo +! + parcours => parcours % next +! + enddo +! + if ( g % child_list % nitems > 0 ) call Agrif_Instance(g) +! +! One step on the current grid + call procname () +! +end subroutine Agrif_Integrate_adj +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Step_Child_adj +! +!> Apply 'procname' to each grid of the hierarchy from Child to Parent +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Step_Child_adj ( procname ) +!--------------------------------------------------------------------------------------------------- + procedure(step_proc) :: procname !< Subroutine to call on each grid +! + call Agrif_Integrate_Child_adj(Agrif_Mygrid,procname) +! + if ( Agrif_Mygrid % child_list % nitems > 0 ) call Agrif_Instance(Agrif_Mygrid) +! +end subroutine Agrif_Step_Child_adj +!=================================================================================================== +! +!=================================================================================================== +! subroutine Agrif_Integrate_Child_adj +! +!> Manages the backward time integration of the grid hierarchy. +!! Recursive subroutine and call on subroutines Agrif_Init::Agrif_Instance & Agrif_Step_adj. +!--------------------------------------------------------------------------------------------------- +recursive subroutine Agrif_Integrate_Child_adj ( g, procname ) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid),pointer :: g !< Pointer on the current grid + procedure(step_proc) :: procname !< Subroutine to call on each grid +! + type(Agrif_PGrid),pointer :: parcours !< Pointer for the recursive procedure +! + parcours => g % child_list % first +! +! Recursive procedure for the time integration of the grid hierarchy + do while (associated(parcours)) +! +! Instanciation of the variables of the current grid + call Agrif_Instance(parcours % gr) + call Agrif_Integrate_Child_adj(parcours % gr, procname) +! + parcours => parcours % next +! + enddo + if ( g % child_list % nitems > 0 ) call Agrif_Instance(g) +! +! One step on the current grid + call procname() +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Integrate_Child_adj +!=================================================================================================== +! +!=================================================================================================== + +end module Agrif_Util diff --git a/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modvariables.F90 b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modvariables.F90 new file mode 100644 index 00000000..7363ef89 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/AGRIF_FILES/modvariables.F90 @@ -0,0 +1,146 @@ +module Agrif_Variables +! + use Agrif_CurgridFunctions +! + implicit none +! +contains +! +!=================================================================================================== +! subroutine Agrif_Declare_Variable +! +!> Declare a new variable profile +!--------------------------------------------------------------------------------------------------- +subroutine Agrif_Declare_Variable ( posvar, firstpoint, raf, lb, ub, varid, torestore ) +!--------------------------------------------------------------------------------------------------- + integer, dimension(:), intent(in) :: posvar !< position of the variable on the cell + !! (1 for the border of the edge, 2 for the center) + integer, dimension(:), intent(in) :: firstpoint !< index of the first point in the real domain + character(1), dimension(:), intent(in) :: raf !< Array indicating the type of dimension (space or not) + !! for each of them + integer, dimension(:), intent(in) :: lb !< Lower bounds of the array + integer, dimension(:), intent(in) :: ub !< Upper bounds of the array + integer, intent(out) :: varid !< Id number of the newly created variable + logical, optional, intent(in) :: torestore !< Indicates if the array restore is used +!--------------------------------------------------------------------------------------------------- + type(Agrif_Variables_List), pointer :: new_varlist + type(Agrif_Variable), pointer :: var + integer :: nbdim, i + logical :: restore + + restore = .FALSE. + if ( Agrif_Mygrid % ngridstep /= 0 ) then + if (present(torestore)) restore = torestore + endif +! + nbdim = SIZE(posvar) +! + allocate(new_varlist) + allocate(new_varlist % var) + + var => new_varlist % var + + allocate(var % posvar(nbdim)) + allocate(var % interptab(nbdim)) + allocate(var % coords(nbdim)) +! + var % nbdim = nbdim + var % interptab = raf(1:nbdim) + var % posvar = posvar(1:nbdim) + var % point(1:nbdim) = firstpoint(1:nbdim) + var % restore = restore +! + do i = 1,nbdim + select case( raf(i) ) + case('x') ; var % coords(i) = 1 + case('y') ; var % coords(i) = 2 + case('z') ; var % coords(i) = 3 + case('N') ; var % coords(i) = 0 + case default ; var % coords(i) = 0 + end select + enddo +! + var % lb(1:nbdim) = lb(1:nbdim) + var % ub(1:nbdim) = ub(1:nbdim) + + if ( restore ) then + select case(nbdim) + case(1) + allocate(var % Restore1D(lb(1):ub(1))) + var % Restore1D = 0 + case(2) + allocate(var % Restore2D(lb(1):ub(1), & + lb(2):ub(2))) + var % Restore2D = 0 + case(3) + allocate(var % Restore3D(lb(1):ub(1), & + lb(2):ub(2), & + lb(3):ub(3))) + var % Restore3D = 0 + case(4) + allocate(var % Restore4D(lb(1):ub(1), & + lb(2):ub(2), & + lb(3):ub(3), & + lb(4):ub(4))) + var % Restore4D = 0 + case(5) + allocate(var % Restore5D(lb(1):ub(1), & + lb(2):ub(2), & + lb(3):ub(3), & + lb(4):ub(4), & + lb(5):ub(5))) + var % Restore5D = 0 + end select + endif + + new_varlist % next => Agrif_Curgrid % variables + + Agrif_Curgrid % variables => new_varlist + Agrif_Curgrid % Nbvariables = Agrif_Curgrid % Nbvariables + 1 + + varid = Agrif_Curgrid % Nbvariables + + var % parent_var => Agrif_Search_Variable(Agrif_Curgrid % parent, Agrif_Curgrid % nbvariables) + var % root_var => Agrif_Search_Variable(Agrif_Mygrid, Agrif_Curgrid % nbvariables) +!--------------------------------------------------------------------------------------------------- +end subroutine Agrif_Declare_Variable +!=================================================================================================== +! +!=================================================================================================== +! function Agrif_Search_Variable +! +!> Returns a pointer to the variable varid for the grid grid. +!--------------------------------------------------------------------------------------------------- +function Agrif_Search_Variable ( grid, varid ) result(outvar) +!--------------------------------------------------------------------------------------------------- + type(Agrif_Grid), pointer :: grid !< Pointer on the current grid. + integer, intent(in) :: varid !< ID number of the variable we are looking for. +! + type(Agrif_Variable), pointer :: outvar + type(Agrif_Variables_List), pointer :: parcours + integer :: nb, varidinv +! + if ( .not.associated(grid) ) then + outvar => NULL() + return + endif +! + parcours => grid % variables + + if (.not. associated(parcours)) then ! can occur on the grand mother grid + outvar => NULL() ! during the first call by agrif_mygrid + return + endif + + varidinv = 1 + grid % nbvariables - varid + + do nb = 1,varidinv-1 + parcours => parcours % next + enddo + + outvar => parcours % var +!--------------------------------------------------------------------------------------------------- +end function Agrif_Search_variable +!=================================================================================================== +! +end module Agrif_Variables diff --git a/CROCO/croco-v1.3.1/AGRIF/LIB/DiversListe.c b/CROCO/croco-v1.3.1/AGRIF/LIB/DiversListe.c new file mode 100644 index 00000000..22c13882 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/LIB/DiversListe.c @@ -0,0 +1,551 @@ +/******************************************************************************/ +/* */ +/* CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran) */ +/* */ +/* Copyright or or Copr. Laurent Debreu (Laurent.Debreu@imag.fr) */ +/* Cyril Mazauric (Cyril_Mazauric@yahoo.fr) */ +/* This software is governed by the CeCILL-C license under French law and */ +/* abiding by the rules of distribution of free software. You can use, */ +/* modify and/ or redistribute the software under the terms of the CeCILL-C */ +/* license as circulated by CEA, CNRS and INRIA at the following URL */ +/* "http://www.cecill.info". */ +/* */ +/* As a counterpart to the access to the source code and rights to copy, */ +/* modify and redistribute granted by the license, users are provided only */ +/* with a limited warranty and the software's author, the holder of the */ +/* economic rights, and the successive licensors have only limited */ +/* liability. */ +/* */ +/* In this respect, the user's attention is drawn to the risks associated */ +/* with loading, using, modifying and/or developing or reproducing the */ +/* software by the user in light of its specific status of free software, */ +/* that may mean that it is complicated to manipulate, and that also */ +/* therefore means that it is reserved for developers and experienced */ +/* professionals having in-depth computer knowledge. Users are therefore */ +/* encouraged to load and test the software's suitability as regards their */ +/* requirements in conditions enabling the security of their systems and/or */ +/* data to be ensured and, more generally, to use and operate it in the */ +/* same conditions as regards security. */ +/* */ +/* The fact that you are presently reading this means that you have had */ +/* knowledge of the CeCILL-C license and that you accept its terms. */ +/******************************************************************************/ +/* version 1.7 */ +/******************************************************************************/ +#include +#include +#include +#include "decl.h" + +/******************************************************************************/ +/* Add_Common_var_1 */ +/******************************************************************************/ +/* This subroutines is used to add the variable defined in common in the */ +/* List_Common_Var */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +void Add_Common_var_1() +{ + listvar *newvar; + listvar *newvar2; + variable *newvariable; + listdim *dims; + char listdimension[LONG_M]; + char ligne[LONG_M]; + int out; + + if ( firstpass == 1 ) + { + newvar = (listvar *) calloc(1,sizeof(listvar)); + newvariable = (variable *) calloc(1,sizeof(variable)); + + Init_Variable(newvariable); + + strcpy(newvariable->v_nomvar,commonvar); + strcpy(newvariable->v_commonname,commonblockname); + strcpy(newvariable->v_modulename,curmodulename); + strcpy(newvariable->v_subroutinename,subroutinename); + strcpy(newvariable->v_commoninfile,cur_filename); + newvariable->v_positioninblock = positioninblock; + newvariable->v_common = 1; + newvar->var = newvariable; + + if ( commondim ) + { + newvariable->v_dimension = commondim; + newvariable->v_dimensiongiven = 1; + newvariable->v_nbdim = get_num_dims(commondim); + + /* Creation of the string for the dimension of this variable */ + dimsempty = 1; + strcpy(listdimension,""); + + dims = commondim; + while (dims) + { + if ( strcasecmp(dims->dim.first,"") || + strcasecmp(dims->dim.last,"")) dimsempty = 0; + sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last); + strcat(listdimension,ligne); + if ( dims->suiv ) strcat(listdimension,","); + dims = dims->suiv; + } + if ( dimsempty == 1 ) newvariable->v_dimsempty = 1; + + strcpy(newvariable->v_readedlistdimension,listdimension); + Save_Length(listdimension,15); + } + + newvar->suiv = NULL; + + if ( !List_Common_Var ) + { + List_Common_Var = newvar; + } + else + { + newvar2 = List_Common_Var; + out = 0 ; + while ( newvar2 && out == 0 ) + { + if ( !strcasecmp(newvar2->var->v_nomvar,commonvar) && + !strcasecmp(newvar2->var->v_commonname,commonblockname) && + !strcasecmp(newvar2->var->v_subroutinename,subroutinename) + ) out = 1 ; + else newvar2 = newvar2->suiv; + } + if ( out == 0 ) + { + newvar->suiv = List_Common_Var; + List_Common_Var = newvar; + } + else + { + free(newvar); + } + } + } +} + +/******************************************************************************/ +/* Addtolistnom */ +/******************************************************************************/ +/* This subroutine is used to add a variable to the list */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +listnom *Addtolistnom(const char *nom, listnom *listin, int value) +{ + listnom *newnom; + listnom *parcours; + int out; + + newnom = (listnom*) calloc(1, sizeof(listnom)); + strcpy(newnom->o_nom, nom); + newnom->o_val = value; + newnom->suiv = NULL; + + if ( listin == NULL ) + { + listin = newnom; + } + else + { + parcours = listin; + out = 0 ; + while ( parcours && out == 0 ) + { + if ( !strcasecmp(parcours->o_nom, nom) ) out = 1 ; + else parcours = parcours->suiv; + } + if ( out == 0 ) + { + newnom->suiv = listin; + listin = newnom; + } + else + { + free(newnom); + } + } + return listin; +} + +/******************************************************************************/ +/* Addtolistname */ +/******************************************************************************/ +/* This subroutine is used to add a variable to the list */ +/******************************************************************************/ +/* _______ _______ _______ _______ _______ */ +/* + + + + + + + + + + */ +/* + NEW +--->+ glob +--->+ glob +--->+ glob +--->+ glob + */ +/* +______+ +______+ +______+ +______+ +______+ */ +/* */ +/* */ +/* */ +/******************************************************************************/ +listname *Addtolistname(const char *nom, listname *input) +{ + listname *newnom; + listname *parcours; + int out; + + if ( !input ) + { + newnom = (listname*) calloc(1, sizeof(listname)); + strcpy(newnom->n_name, nom); + newnom->suiv = NULL; + input = newnom; + } + else + { + parcours = input; + out = 0 ; + while ( parcours && out == 0 ) + { + if ( !strcasecmp(parcours->n_name,nom) ) out = 1; + else parcours=parcours->suiv; + } + if ( out == 0 ) + { + newnom = (listname*) calloc(1,sizeof(listname)); + strcpy(newnom->n_name, nom); + newnom->suiv = input; + input = newnom; + } + } + return input; +} + +/******************************************************************************/ +/* ModuleIsDefineInInputFile */ +/******************************************************************************/ +/* This subroutine is used to know if the module is defined in the input file */ +/******************************************************************************/ +/* */ +/* */ +/******************************************************************************/ +int ModuleIsDefineInInputFile(const char *name) +{ + listnom *newnom; + int out; + + out = 0; + if ( listofmodules ) + { + newnom = listofmodules; + while( newnom && out == 0 ) + { + if ( !strcasecmp(newnom->o_nom,name) ) out = 1 ; + else newnom = newnom->suiv; + } + } + return out; +} + +/******************************************************************************/ +/* Addmoduletothelisttmp */ +/******************************************************************************/ +/* This subroutine is used to add a record to a list of struct */ +/* listusemodule */ +/******************************************************************************/ +/* */ +/* subroutine sub ... USE mod1 ===> insert in list */ +/* _______ _______ _______ _______ _______ */ +/* + + + + + + + + + + */ +/* + NEW +--->+ list +--->+ list +--->+ list +--->+ list + */ +/* +______+ +______+ +______+ +______+ +______+ */ +/* */ +/* list = listofmoduletmp */ +/* */ +/******************************************************************************/ +void Addmoduletothelisttmp(const char *name) +{ + listusemodule *newmodule; + listusemodule *parcours; + int out; + + if ( !listofmoduletmp ) + { + newmodule = (listusemodule*) calloc(1, sizeof(listusemodule)); + strcpy(newmodule->u_usemodule, name); + strcpy(newmodule->u_cursubroutine, subroutinename); + newmodule->suiv = NULL; + listofmoduletmp = newmodule ; + } + else + { + parcours = listofmoduletmp; + out = 0; + while( parcours && out == 0 ) + { + if ( !strcasecmp(parcours->u_usemodule, name) ) out = 1; + else parcours = parcours->suiv; + } + if ( out == 0 ) + { + newmodule = (listusemodule*) calloc(1, sizeof(listusemodule)); + strcpy(newmodule->u_usemodule, name); + strcpy(newmodule->u_cursubroutine, subroutinename); + newmodule->suiv = listofmoduletmp; + listofmoduletmp = newmodule; + } + } +} + +/******************************************************************************/ +/* Add_NameOfModule_1 */ +/******************************************************************************/ +/* This subroutine is used to add a variable to the list */ +/******************************************************************************/ +/* _______ _______ _______ _______ _______ */ +/* + + + + + + + + + + */ +/* + NEW +--->+ glob +--->+ glob +--->+ glob +--->+ glob + */ +/* +______+ +______+ +______+ +______+ +______+ */ +/* */ +/* */ +/* */ +/******************************************************************************/ +void Add_NameOfModule_1(const char *nom) +{ + listnom *newnom; + + if ( firstpass == 1 ) + { + newnom = (listnom *) calloc(1,sizeof(listnom)); + strcpy(newnom->o_nom,nom); + newnom->suiv = List_NameOfModule; + List_NameOfModule = newnom; + } +} + +/******************************************************************************/ +/* Add_NameOfCommon_1 */ +/******************************************************************************/ +/* This subroutine is used to add a variable to the list */ +/******************************************************************************/ +/* _______ _______ _______ _______ _______ */ +/* + + + + + + + + + + */ +/* + NEW +--->+ glob +--->+ glob +--->+ glob +--->+ glob + */ +/* +______+ +______+ +______+ +______+ +______+ */ +/* */ +/* */ +/* */ +/******************************************************************************/ +void Add_NameOfCommon_1(const char *nom, const char *cursubroutinename) +{ + listnom *newnom; + listnom *parcours; + + if ( firstpass == 1 ) + { + parcours = List_NameOfCommon; + while ( parcours && strcasecmp(parcours->o_nom,nom) ) + parcours = parcours->suiv; + if ( !parcours ) + { + newnom = (listnom *) calloc(1,sizeof(listnom)); + strcpy(newnom->o_nom,nom); + strcpy(newnom->o_subroutinename,cursubroutinename); + newnom->suiv = List_NameOfCommon; + List_NameOfCommon = newnom; + } + } +} + +/******************************************************************************/ +/* Add_CouplePointed_Var_1 */ +/******************************************************************************/ +/* Firstpass 1 */ +/* We should complete the listvarpointtovar */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +void Add_CouplePointed_Var_1(const char *namemodule, listcouple *couple) +{ + listvarpointtovar *pointtmp; + + /* we should complete the List_CouplePointed_Var */ + pointtmp = (listvarpointtovar*) calloc(1, sizeof(listvarpointtovar)); + strcpy(pointtmp->t_usemodule, namemodule); + strcpy(pointtmp->t_cursubroutine, subroutinename); + pointtmp->t_couple = couple; + if ( List_CouplePointed_Var ) + { + pointtmp->suiv = List_CouplePointed_Var; + } + else + { + pointtmp->suiv = NULL; + } + List_CouplePointed_Var = pointtmp; +} + +/******************************************************************************/ +/* Add_Include_1 */ +/******************************************************************************/ +/* This subroutine is used to add a record to a list of struct */ +/* List_Include */ +/******************************************************************************/ +/* */ +/* subroutine sub ... include mod1 ===> insert in list */ +/* _______ _______ _______ _______ _______ */ +/* + + + + + + + + + + */ +/* + NEW +--->+ list +--->+ list +--->+ list +--->+ list + */ +/* +______+ +______+ +______+ +______+ +______+ */ +/* */ +/* list = List_Include */ +/* */ +/******************************************************************************/ +void Add_Include_1(const char *name) +{ + listusemodule *newinclude; + + if ( firstpass == 1 ) + { + newinclude = (listusemodule*) calloc(1, sizeof(listusemodule)); + strcpy(newinclude->u_usemodule,name); + strcpy(newinclude->u_cursubroutine,subroutinename); + + newinclude->suiv = List_Include; + List_Include = newinclude ; + } +} + +/******************************************************************************/ +/* Add_ImplicitNoneSubroutine_1 */ +/******************************************************************************/ +/* This subroutine is used to add a record to a list of struct */ +/******************************************************************************/ +/* */ +/* */ +/******************************************************************************/ +void Add_ImplicitNoneSubroutine_1() +{ + if ( firstpass == 1 ) + List_ImplicitNoneSubroutine = Addtolistname(subroutinename,List_ImplicitNoneSubroutine); +} + +/******************************************************************************/ +/* WriteIncludeDeclaration */ +/******************************************************************************/ +/* Firstpass 0 */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +void WriteIncludeDeclaration(FILE* tofile) +{ + listusemodule *newinclude; + + newinclude = List_Include; + fprintf(tofile,"\n"); + while ( newinclude ) + { + if ( !strcasecmp(newinclude->u_cursubroutine,subroutinename) ) + { + fprintf(tofile, " include %s\n",newinclude->u_usemodule); + } + newinclude = newinclude ->suiv; + } +} + +/******************************************************************************/ +/* Add_Save_Var_1 */ +/******************************************************************************/ +/* This subroutine is used to add a record to List_Save_Var */ +/******************************************************************************/ +/* _______ _______ _______ _______ _______ */ +/* + + + + + + + + + + */ +/* + NEW +--->+ Save +--->+ Save +--->+ Save +--->+ Save+ */ +/* +______+ +______+ +______+ +______+ +______+ */ +/* */ +/******************************************************************************/ +void Add_Save_Var_1 (const char *name, listdim *d) +{ + listvar *newvar; + listdim *dims; + char ligne[LONG_M]; + char listdimension[LONG_M]; + + if ( firstpass == 1 ) + { + newvar = (listvar *) calloc(1,sizeof(listvar)); + newvar->var = (variable *) calloc(1,sizeof(variable)); + + Init_Variable(newvar->var); + + newvar->var->v_save = 1; + strcpy(newvar->var->v_nomvar,name); + strcpy(newvar->var->v_modulename,curmodulename); + if (strcasecmp(curmodulename,"")) + { + newvar->var->v_module=1; + } + strcpy(newvar->var->v_subroutinename,subroutinename); + strcpy(newvar->var->v_commoninfile,cur_filename); + + newvar->var->v_dimension = d; + + /* Creation of the string for the dimension of this variable */ + dimsempty = 1; + + if ( d ) + { + newvar->var->v_dimensiongiven = 1; + dims = d; + while (dims) + { + if ( strcasecmp(dims->dim.first,"") || strcasecmp(dims->dim.last,"")) + dimsempty = 0; + sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last); + strcat(listdimension,ligne); + if ( dims->suiv ) strcat(listdimension,","); + dims = dims->suiv; + } + if ( dimsempty == 1 ) newvar->var->v_dimsempty = 1; + } + + newvar->suiv = List_Save_Var; + List_Save_Var = newvar; + } +} + +void Add_Save_Var_dcl_1 (listvar *var) +{ + listvar *newvar; + listvar *parcours; + + if ( firstpass == 1 ) + { + parcours = var; + while ( parcours ) + { + newvar = (listvar *) calloc(1,sizeof(listvar)); + newvar->var = (variable *) calloc(1,sizeof(variable)); + + Init_Variable(newvar->var); + newvar->var->v_save = 1; + strcpy(newvar->var->v_nomvar,parcours->var->v_nomvar); + strcpy(newvar->var->v_dimchar,parcours->var->v_dimchar); + strcpy(newvar->var->v_modulename,curmodulename); + strcpy(newvar->var->v_subroutinename,subroutinename); + strcpy(newvar->var->v_commoninfile,cur_filename); + strcpy(newvar->var->v_readedlistdimension,parcours->var->v_readedlistdimension); + + newvar->var->v_nbdim = parcours->var->v_nbdim; + strcpy(newvar->var->v_typevar,parcours->var->v_typevar); + strcpy(newvar->var->v_precision,parcours->var->v_precision); + newvar->var->v_catvar = parcours->var->v_catvar; + newvar->var->v_dimension = parcours->var->v_dimension; + newvar->var->v_dimensiongiven=parcours->var->v_dimensiongiven; + newvar->var->v_allocatable = parcours->var->v_allocatable; + newvar->var->v_initialvalue = parcours->var->v_initialvalue; + newvar->var->v_initialvalue_array = parcours->var->v_initialvalue_array; + newvar->suiv = List_Save_Var; + List_Save_Var = newvar; + + parcours = parcours->suiv; + } + } +} diff --git a/CROCO/croco-v1.3.1/AGRIF/LIB/Makefile b/CROCO/croco-v1.3.1/AGRIF/LIB/Makefile new file mode 100644 index 00000000..973b81f9 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/LIB/Makefile @@ -0,0 +1,68 @@ +OBJS = main.o WriteInFile.o toamr.o fortran.o \ + dependfile.o SubLoopCreation.o WorkWithlistvarindoloop.o \ + WorkWithvarofsubroutineliste.o WorkWithParameterlist.o \ + Writedeclarations.o WorkWithglobliste.o UtilFortran.o \ + UtilNotGridDep.o WorkWithlistdatavariable.o \ + DiversListe.o UtilAgrif.o WorkWithAllocatelist.o \ + UtilCharacter.o UtilListe.o UtilFile.o \ + WorkWithlistofmodulebysubroutine.o WorkWithlistmoduleinfile.o \ + WorkWithlistofcoupled.o + +.SUFFIXES: +.SUFFIXES: .c .o + +all: conv + @echo + @echo =================================================== + @echo CONV is ok + @echo =================================================== + @echo +# Modif Laurent Debreu car Version de bison trop ancienne => Eviter l'appel a Bison +#main.c: convert.y convert.lex +# @echo =================================================== +# @echo Rebuilding main.c ... +# @echo =================================================== +# $(MAKE) -f Makefile.lex main.c +# +#fortran.c: fortran.y fortran.lex +# @echo =================================================== +# @echo Rebuilding fortran.c ... +# @echo =================================================== +# $(MAKE) -f Makefile.lex fortran.c + +conv: $(OBJS) + $(CC) $(CFLAGS) $(OBJS) -o ./$@ + +%.o: %.c + $(CC) -Wno-implicit-function-declaration $(CFLAGS) -c $< -o $@ + +main.o : main.c +fortran.o : fortran.c +toamr.o : toamr.c decl.h +WriteInFile.o : WriteInFile.c decl.h +dependfile.o : dependfile.c decl.h +SubLoopCreation.o : SubLoopCreation.c decl.h +WorkWithglobliste.o : WorkWithglobliste.c decl.h +WorkWithlistvarindoloop.o : WorkWithlistvarindoloop.c decl.h +WorkWithvarofsubroutineliste.o : WorkWithvarofsubroutineliste.c decl.h +Writedeclarations.o : Writedeclarations.c decl.h +UtilFortran.o : UtilFortran.c decl.h +WorkWithParameterlist.o : WorkWithParameterlist.c decl.h +UtilNotGridDep.o : UtilNotGridDep.c decl.h +WorkWithlistdatavariable.o : WorkWithlistdatavariable.c decl.h +DiversListe.o : DiversListe.c decl.h +UtilAgrif.o : UtilAgrif.c decl.h +WorkWithAllocatelist.o : WorkWithAllocatelist.c decl.h +UtilCharacter.o : UtilCharacter.c decl.h +UtilListe.o : UtilListe.c decl.h +UtilFile.o : UtilFile.c decl.h +WorkWithlistofmodulebysubroutine.o : WorkWithlistofmodulebysubroutine.c decl.h +WorkWithlistmoduleinfile.o : WorkWithlistmoduleinfile.c decl.h +WorkWithlistofcoupled.o : WorkWithlistofcoupled.c decl.h + +clean: + $(MAKE) -f Makefile.lex clean + $(RM) *.o conv + +clean-all: clean + $(MAKE) -f Makefile.lex clean-all diff --git a/CROCO/croco-v1.3.1/AGRIF/LIB/SubLoopCreation.c b/CROCO/croco-v1.3.1/AGRIF/LIB/SubLoopCreation.c new file mode 100644 index 00000000..2a5f6abb --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/LIB/SubLoopCreation.c @@ -0,0 +1,449 @@ +/******************************************************************************/ +/* */ +/* CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran) */ +/* */ +/* Copyright or or Copr. Laurent Debreu (Laurent.Debreu@imag.fr) */ +/* Cyril Mazauric (Cyril_Mazauric@yahoo.fr) */ +/* This software is governed by the CeCILL-C license under French law and */ +/* abiding by the rules of distribution of free software. You can use, */ +/* modify and/ or redistribute the software under the terms of the CeCILL-C */ +/* license as circulated by CEA, CNRS and INRIA at the following URL */ +/* "http://www.cecill.info". */ +/* */ +/* As a counterpart to the access to the source code and rights to copy, */ +/* modify and redistribute granted by the license, users are provided only */ +/* with a limited warranty and the software's author, the holder of the */ +/* economic rights, and the successive licensors have only limited */ +/* liability. */ +/* */ +/* In this respect, the user's attention is drawn to the risks associated */ +/* with loading, using, modifying and/or developing or reproducing the */ +/* software by the user in light of its specific status of free software, */ +/* that may mean that it is complicated to manipulate, and that also */ +/* therefore means that it is reserved for developers and experienced */ +/* professionals having in-depth computer knowledge. Users are therefore */ +/* encouraged to load and test the software's suitability as regards their */ +/* requirements in conditions enabling the security of their systems and/or */ +/* data to be ensured and, more generally, to use and operate it in the */ +/* same conditions as regards security. */ +/* */ +/* The fact that you are presently reading this means that you have had */ +/* knowledge of the CeCILL-C license and that you accept its terms. */ +/******************************************************************************/ +/* version 1.7 */ +/******************************************************************************/ +#include +#include +#include +#include "decl.h" + + +/******************************************************************************/ +/* preparation and write of the argument list of a subroutine */ +/******************************************************************************/ + + +/******************************************************************************/ +/* WriteBeginof_SubLoop */ +/******************************************************************************/ +/* We should write the head of the subroutine sub_loop_ */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +void WriteBeginof_SubLoop() +{ + if (todebug == 1) printf("##\n## Enter in HEAD SUBLOOP for |%s|\n##\n", subroutinename); + if ( IsTabvarsUseInArgument_0() == 1 ) + { + if ( todebug == 1 ) printf("> enter in WriteBeginof_SubLoop : IsTabvarsUseInArgument_0() == 1\n"); + /* we should add the use agrif_uti l if it is necessary */ + if (todebug == 1) fprintf(fortran_out,"\n !DEBUG: Avant WriteHeadofSubroutineLoop\n"); + WriteHeadofSubroutineLoop(); + if (todebug == 1) fprintf(fortran_out," !DEBUG: Apres WriteHeadofSubroutineLoop\n"); + fflush(fortran_out); + if (todebug == 1) { + fprintf(fortran_out," !DEBUG: Avant WriteUsemoduleDeclaration\n"); + } + + WriteUsemoduleDeclaration(subroutinename); + if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortran_out, " implicit none\n"); + WriteIncludeDeclaration(fortran_out); + if (todebug == 1) fprintf(fortran_out," !DEBUG: Avant WriteIncludeDeclaration\n"); + /* */ + /* We should write once the declaration of tables (extract */ + /* from pointer) in the new subroutine */ + if ( SubInList_ContainsSubroutine() == 0 ) WriteLocalParamDeclaration(fortran_out); + + writesub_loopdeclaration_scalar(List_UsedInSubroutine_Var,fortran_out); + writesub_loopdeclaration_tab(List_UsedInSubroutine_Var,fortran_out); + WriteArgumentDeclaration_Sort(fortran_out); + WriteFunctionDeclaration(fortran_out, 1); + } + else + { + if ( todebug == 1 ) printf("> enter in WriteBeginof_SubLoop : IsTabvarsUseInArgument_0() == 0\n"); + AddUseAgrifUtil_0(fortran_out); + WriteUsemoduleDeclaration(subroutinename); + if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortran_out, " implicit none\n"); + WriteIncludeDeclaration(fortran_out); + WriteLocalParamDeclaration(fortran_out); + WriteArgumentDeclaration_beforecall(); + if (todebug == 1) fprintf(fortran_out," !DEBUG: Avant WriteFunctionDeclaration\n"); + if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(fortran_out, 1); +/* writesub_loopdeclaration_scalar(List_SubroutineArgument_Var,fortran_out); + writesub_loopdeclaration_tab(List_SubroutineArgument_Var,fortran_out);*/ + } + if ( todebug == 1 ) printf("< out of WriteBeginof_SubLoop\n"); + if ( todebug == 1 ) printf("## EXIT HEAD SUBLOOP (%s)\n\n", subroutinename); +} + +/******************************************************************************/ +/* WriteVariablelist_subloop */ +/******************************************************************************/ +/* This subroutine is used to write the list of the variable which */ +/* should be called by the sub_loop_ subroutine */ +/* The first part is composed by the list of the local variables */ +/******************************************************************************/ +/* */ +/* List_SubroutineDeclaration_Var a,b,c, & */ +/* d,e,f, & */ +/* a,b,c,d,e,f,g,h ========> g,h */ +/* */ +/******************************************************************************/ +void WriteVariablelist_subloop(char **ligne, size_t *line_length) +{ + listvar *parcours; + + if ( todebug == 1 ) printf("> enter in WriteVariablelist_subloop\n"); + parcours = List_SubroutineArgument_Var; + didvariableadded = 0; + + while ( parcours ) + { + /* if the readed variable is a variable of the subroutine */ + /* subroutinename we should write the name of this variable */ + /* in the output file */ + if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) ) + { + if ( didvariableadded == 1 ) strcat(*ligne,","); + if ( (strlen(*ligne)+strlen(parcours->var->v_nomvar)+100) > *line_length ) + { + *line_length += LONG_M; + *ligne = realloc( *ligne, *line_length*sizeof(char) ); + } + strcat(*ligne,parcours->var->v_nomvar); + didvariableadded = 1; + } + parcours = parcours -> suiv; + } + parcours = List_FunctionType_Var; + while ( parcours ) + { + if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) ) + { + if ( didvariableadded == 1 ) strcat(*ligne,","); + if ( (strlen(*ligne)+strlen(parcours->var->v_nomvar)+100) > *line_length ) + { + *line_length += LONG_M; + *ligne = realloc( *ligne, *line_length*sizeof(char) ); + } + strcat(*ligne,parcours->var->v_nomvar); + didvariableadded = 1; + } + parcours = parcours -> suiv; + } + if ( todebug == 1 ) printf("< out of WriteVariablelist_subloop\n"); +} + + +/******************************************************************************/ +/* WriteVariablelist_subloop_Call */ +/******************************************************************************/ +/* This subroutine is used to write the list of the variable which */ +/* should be called by the sub_loop_ subroutine into the called */ +/* The second part is composed by the list of the global table */ +/******************************************************************************/ +/* */ +/* List_UsedInSubroutine_Var SubloopScalar = 0 | SubloopScalar = 1 */ +/* a,b,c, & | a,b(1,1),c, & */ +/* a,b,c,d,e,f,g,h =====> d,e,f, & | d(1),e(1,1,1),f, & */ +/* g,h | g,h(1,1) */ +/* */ +/******************************************************************************/ +void WriteVariablelist_subloop_Call(char **ligne, size_t *line_length) +{ + listvar *parcours; + char ligne2[LONG_M]; + int i; + + if ( todebug == 1 ) printf("> enter in WriteVariablelist_subloop_Call\n"); + parcours = List_UsedInSubroutine_Var; + + while ( parcours ) + { + /* if the readed variable is a variable of the subroutine */ + /* subroutinename we should write the name of this variable */ + /* in the output file */ + if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) && + (parcours->var->v_pointerdeclare >= 0 || !strcasecmp(parcours->var->v_typevar,"type")) + ) + { + if ( didvariableadded == 1 ) strcat(*ligne,","); + const char *vres = vargridcurgridtabvars(parcours->var, 0); + if ( (strlen(*ligne)+strlen(parcours->var->v_nomvar)+100) > *line_length ) + { + *line_length += LONG_M; + *ligne = realloc( *ligne, *line_length*sizeof(char) ); + } + strcat(*ligne, vres); + /* if it is asked in the call of the conv we should give */ + /* scalar in argument, so we should put (1,1,1) after the */ + /* the name of the variable */ + if ( SubloopScalar != 0 && + ( + (parcours->var->v_pointerdeclare >= 0 || !strcasecmp(parcours->var->v_typevar,"type"))) && + parcours->var->v_nbdim != 0 ) + { + i = 1; + while ( i <= parcours->var->v_nbdim ) + { + if ( i == 1 ) strcat(*ligne,"( "); + if ( SubloopScalar == 2 ) + { + strcat(*ligne,":"); + if ( i != parcours->var->v_nbdim ) strcat(*ligne,","); + } + else + { + sprintf(ligne2,"lbound(%s,%d",vargridcurgridtabvars(parcours->var,0),i); + strcat(*ligne,ligne2); + if ( i != parcours->var->v_nbdim ) strcat(*ligne,"),"); + } + if ( i == parcours->var->v_nbdim ) strcat(*ligne,"))"); + i++; + } + } + didvariableadded = 1; + } + parcours = parcours -> suiv; + } + if ( todebug == 1 ) printf("< out of WriteVariablelist_subloop_Call\n"); +} + + +/******************************************************************************/ +/* WriteVariablelist_subloop_Def */ +/******************************************************************************/ +/* This subroutine is used to write the list of the variable which */ +/* should be called by the sub_loop_ subroutine into the def */ +/* The second part is composed by the list of the global table */ +/* _tmp */ +/******************************************************************************/ +/* */ +/* List_UsedInSubroutine_Var */ +/* a-tmp,b-tmp,c_tmp, & */ +/* a,b,c,d,e,f,g,h =====> d_tmp,e_tmp,f_tmp, & */ +/* g_tmp,h_tmp */ +/* */ +/******************************************************************************/ +void WriteVariablelist_subloop_Def(char **ligne, size_t *line_length) +{ + listvar *parcours; + + if ( todebug == 1 ) printf("> enter in WriteVariablelist_subloop_Def\n"); + parcours = List_UsedInSubroutine_Var; + + while ( parcours ) + { + /* if the readed variable is a variable of the subroutine */ + /* subrotinename we should write the name of this variable */ + /* in the output file */ + if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) && + (parcours->var->v_pointerdeclare >= 0 || !strcasecmp(parcours->var->v_typevar,"type")) ) + { + if ( didvariableadded == 1 ) strcat(*ligne,","); + if ( (strlen(*ligne)+strlen(parcours->var->v_nomvar)+100) > *line_length ) + { + *line_length += LONG_M; + *ligne = realloc( *ligne, *line_length*sizeof(char) ); + } + strcat(*ligne,parcours->var->v_nomvar); + didvariableadded = 1; + } + parcours = parcours -> suiv; + } + + if ( todebug == 1 ) printf("< out of WriteVariablelist_subloop_Def\n"); +} + +/******************************************************************************/ +/* WriteHeadofSubroutineLoop */ +/******************************************************************************/ +/* This subroutine is used to write the head of the subroutine */ +/* Sub_Loop_ */ +/******************************************************************************/ +/* Sub_loop_subroutine.h */ +/* */ +/* subroutine Sub_Loop_subroutine ( & */ +/* a,b,c, & */ +/* SubLoopScalar d,e(1,1),f(1,1,1), & */ +/* g,h & */ +/* ) */ +/******************************************************************************/ +void WriteHeadofSubroutineLoop() +{ + char *ligne; + FILE * subloop; + size_t line_length; + + ligne = (char*) calloc(LONG_M, sizeof(char)); + line_length = LONG_M; + + if ( todebug == 1 ) printf("> enter in WriteHeadofSubroutineLoop subroutine %s\n",subroutinename); + tofich(fortran_out,"\n",1); + + /* Open this newfile */ + sprintf(ligne,"Sub_Loop_%s.h",subroutinename); + subloop = open_for_write(ligne); + /* */ + if (isrecursive) sprintf(ligne,"recursive subroutine Sub_Loop_%s(",subroutinename); + else sprintf(ligne,"subroutine Sub_Loop_%s(",subroutinename); + + /* */ + if (todebug == 1) fprintf(subloop," !DEBUG: Avant WriteVariablelist_subloop\n"); + WriteVariablelist_subloop(&ligne,&line_length); + WriteVariablelist_subloop_Def(&ligne,&line_length); + /* */ + strcat(ligne,")"); + tofich(subloop,ligne,1); + + /* if USE agrif_Uti l should be add */ + if (todebug == 1) fprintf(subloop," !DEBUG: Avant AddUseAgrifUtil_0\n"); + AddUseAgrifUtil_0(subloop); + + /* */ + if (todebug == 1) fprintf(subloop," !DEBUG: Apres AddUseAgrifUtil_0\n"); + oldfortran_out = fortran_out; + fortran_out = subloop; + + if ( todebug == 1 ) printf("< out of WriteHeadofSubroutineLoop\n"); + + free(ligne); +} + +/******************************************************************************/ +/* closeandcallsubloopandincludeit_0 */ +/******************************************************************************/ +/* Firstpass 0 */ +/* We should close the sub_loop subroutine, call it and close the */ +/* function (suborfun = 0) */ +/* subroutine (suborfun = 1) */ +/* end (suborfun = 2) */ +/* end program (suborfun = 3) */ +/* and include the sub_loop subroutine after */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +void closeandcallsubloopandincludeit_0(int suborfun) +{ + char *ligne; + size_t line_length; + + if ( firstpass == 1 ) return; + if ( todebug == 1 ) printf("> enter in closeandcallsubloopandincludeit_0\n"); + + ligne = (char*) calloc(LONG_M, sizeof(char)); + line_length = LONG_M; + + if ( IsTabvarsUseInArgument_0() == 1 ) + { + /* We should remove the key word end subroutine */ + RemoveWordCUR_0(fortran_out,setposcur()-pos_endsubroutine); + /* We should close the loop subroutine */ + tofich(fortran_out,"\n",1); + sprintf(ligne,"end subroutine Sub_Loop_%s\n",subroutinename); + tofich(fortran_out,ligne,1); + fclose(fortran_out); + fortran_out = oldfortran_out; + + AddUseAgrifUtilBeforeCall_0(fortran_out); + + WriteArgumentDeclaration_beforecall(); + if (todebug == 1) fprintf(fortran_out," !DEBUG: Avant WriteFunctionDeclaration\n"); + + if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(fortran_out, 0); + if ( !strcasecmp(subofagrifinitgrids,subroutinename) ) + fprintf(fortran_out," call Agrif_Init_Grids()\n"); + /* Now we add the call af the new subroutine */ + tofich(fortran_out,"\n",1); + sprintf(ligne," call Sub_Loop_%s(",subroutinename); + /* Write the list of the local variables used in this new subroutine */ + WriteVariablelist_subloop(&ligne,&line_length); + /* Write the list of the global tables used in this new subroutine */ + /* in doloop */ + WriteVariablelist_subloop_Call(&ligne, &line_length); + /* Close the parenthesis of the new subroutine called */ + strcat(ligne,")\n"); + tofich(fortran_out,ligne,1); + /* we should include the above file in the original code */ + + /* We should close the original subroutine */ + if ( suborfun == 3 ) fprintf(fortran_out, " end program %s\n" , subroutinename); + if ( suborfun == 2 ) fprintf(fortran_out, " end\n"); + if ( suborfun == 1 ) fprintf(fortran_out, " end subroutine %s\n", subroutinename); + if ( suborfun == 0 ) fprintf(fortran_out, " end function %s\n" , subroutinename); + + fprintf(fortran_out,"\n\n#include \"Sub_Loop_%s.h\"\n",subroutinename); + } + oldfortran_out = (FILE *)NULL; + if ( todebug == 1 ) printf("< out of closeandcallsubloopandincludeit_0\n"); + + free(ligne); +} + +void closeandcallsubloop_contains_0() +{ + char *ligne; + size_t line_length; + + if ( todebug == 1 ) printf("> enter in closeandcallsubloop_contains_0\n"); + if ( IsTabvarsUseInArgument_0() == 1 ) + { + ligne = (char*) calloc(LONG_M, sizeof(char)); + line_length = LONG_M; + RemoveWordCUR_0(fortran_out,9); // Remove word 'contains' + tofich(fortran_out,"\n",1); + sprintf(ligne,"end subroutine Sub_Loop_%s\n",subroutinename); + tofich(fortran_out,ligne,1); + fclose(fortran_out); + fortran_out = oldfortran_out; + + AddUseAgrifUtilBeforeCall_0(fortran_out); + if ( ImplicitNoneInSubroutine() == 1 ) fprintf(fortran_out, " implicit none\n"); + WriteLocalParamDeclaration(fortran_out); + printf("ICI3\n"); + WriteArgumentDeclaration_beforecall(); + if (todebug == 1) fprintf(fortran_out," !DEBUG: Avant WriteFunctionDeclaration\n"); + if ( functiondeclarationisdone == 0 ) WriteFunctionDeclaration(fortran_out, 0); +/* WriteSubroutineDeclaration(0);*/ + if ( !strcasecmp(subofagrifinitgrids,subroutinename) ) + fprintf(fortran_out," call Agrif_Init_Grids()\n"); + /* Now we add the call af the new subroutine */ + tofich(fortran_out,"\n",1); + sprintf(ligne," call Sub_Loop_%s(",subroutinename); + /* Write the list of the local variables used in this new subroutine */ + WriteVariablelist_subloop(&ligne,&line_length); + /* Write the list of the global tables used in this new subroutine */ + /* in doloop */ + WriteVariablelist_subloop_Call(&ligne, &line_length); + /* Close the parenthesis of the new subroutine called */ + strcat(ligne,")\n"); + tofich(fortran_out,ligne,1); + /* We should close the original subroutine */ + fprintf(fortran_out, " contains\n"); + /* we should include the above file in the original code */ + fprintf(fortran_out,"#include \"Sub_Loop_%s.h\"\n",subroutinename); + } + oldfortran_out = (FILE *)NULL; + if ( todebug == 1 ) printf("< out of closeandcallsubloop_contains_0\n"); +} diff --git a/CROCO/croco-v1.3.1/AGRIF/LIB/UtilAgrif.c b/CROCO/croco-v1.3.1/AGRIF/LIB/UtilAgrif.c new file mode 100644 index 00000000..c212a751 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/LIB/UtilAgrif.c @@ -0,0 +1,838 @@ +/******************************************************************************/ +/* */ +/* CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran) */ +/* */ +/* Copyright or or Copr. Laurent Debreu (Laurent.Debreu@imag.fr) */ +/* Cyril Mazauric (Cyril_Mazauric@yahoo.fr) */ +/* This software is governed by the CeCILL-C license under French law and */ +/* abiding by the rules of distribution of free software. You can use, */ +/* modify and/ or redistribute the software under the terms of the CeCILL-C */ +/* license as circulated by CEA, CNRS and INRIA at the following URL */ +/* "http://www.cecill.info". */ +/* */ +/* As a counterpart to the access to the source code and rights to copy, */ +/* modify and redistribute granted by the license, users are provided only */ +/* with a limited warranty and the software's author, the holder of the */ +/* economic rights, and the successive licensors have only limited */ +/* liability. */ +/* */ +/* In this respect, the user's attention is drawn to the risks associated */ +/* with loading, using, modifying and/or developing or reproducing the */ +/* software by the user in light of its specific status of free software, */ +/* that may mean that it is complicated to manipulate, and that also */ +/* therefore means that it is reserved for developers and experienced */ +/* professionals having in-depth computer knowledge. Users are therefore */ +/* encouraged to load and test the software's suitability as regards their */ +/* requirements in conditions enabling the security of their systems and/or */ +/* data to be ensured and, more generally, to use and operate it in the */ +/* same conditions as regards security. */ +/* */ +/* The fact that you are presently reading this means that you have had */ +/* knowledge of the CeCILL-C license and that you accept its terms. */ +/******************************************************************************/ +/* version 1.7 */ +/******************************************************************************/ +#include +#include +#include +#include "decl.h" +/******************************************************************************/ +/* Vartonumber */ +/******************************************************************************/ +/* This subroutine is used to know if Agrif_ is locate in the char */ +/* tokname */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +int Vartonumber(const char *tokname) +{ + int agrifintheword; + + agrifintheword = 0; + if ( !strcasecmp(tokname,"Agrif_parent") ) agrifintheword = 1; + else if ( !strcasecmp(tokname,"Agrif_set_type") ) agrifintheword = 1; + else if ( !strcasecmp(tokname,"Agrif_set_raf") ) agrifintheword = 1; + else if ( !strcasecmp(tokname,"Agrif_set_bc") ) agrifintheword = 1; + else if ( !strcasecmp(tokname,"Agrif_set_bcinterp") ) agrifintheword = 1; + else if ( !strcasecmp(tokname,"Agrif_Root") ) agrifintheword = 1; + else if ( !strcasecmp(tokname,"Agrif_CFixed") ) agrifintheword = 1; + else if ( !strcasecmp(tokname,"Agrif_Fixed") ) agrifintheword = 1; + else if ( !strcasecmp(tokname,"Agrif_bc_variable") ) agrifintheword = 1; + else if ( !strcasecmp(tokname,"Agrif_set_parent") ) agrifintheword = 1; + else if ( !strcasecmp(tokname,"Agrif_interp_variable")) agrifintheword = 1; + else if ( !strcasecmp(tokname,"Agrif_init_variable") ) agrifintheword = 1; + else if ( !strcasecmp(tokname,"Agrif_update_variable")) agrifintheword = 1; + else if ( !strcasecmp(tokname,"Agrif_Set_interp") ) agrifintheword = 1; + else if ( !strcasecmp(tokname,"Agrif_Set_Update") ) agrifintheword = 1; + else if ( !strcasecmp(tokname,"Agrif_Set_UpdateType") ) agrifintheword = 1; + else if ( !strcasecmp(tokname,"Agrif_Set_restore") ) agrifintheword = 1; + else if ( !strcasecmp(tokname,"Agrif_Save_Forrestore")) agrifintheword = 1; + else if ( !strcasecmp(tokname,"Agrif_init_grids") ) agrifintheword = 1; + else if ( !strcasecmp(tokname,"Agrif_step") ) agrifintheword = 1; +/**************************************************/ +/* adding specific adjoint agrif subroutine names */ +/**************************************************/ + else if ( !strcasecmp(tokname,"Agrif_bc_variable_adj") ) agrifintheword = 1; + else if ( !strcasecmp(tokname,"Agrif_update_variable_adj")) agrifintheword = 1; + + return agrifintheword; +} + +/******************************************************************************/ +/* Agrif_in_Tok_NAME */ +/******************************************************************************/ +/* This subroutine is used to know if Agrif_ is locate in the char */ +/* tokname */ +/******************************************************************************/ +/* */ +/* Agrif_name --------------> Agrif_in_Tok_NAME = 1 */ +/* name --------------> Agrif_in_Tok_NAME = 0 */ +/* */ +/******************************************************************************/ +int Agrif_in_Tok_NAME(const char *tokname) +{ + return ( strncasecmp(tokname,"Agrif_",6) == 0 ); +} + +/******************************************************************************/ +/* ModifyTheVariableName_0 */ +/******************************************************************************/ +/* Firstpass 0 */ +/******************************************************************************/ +/* */ +/* Agrif_(variable) ====> Agrif_(variable) */ +/* */ +/******************************************************************************/ +void ModifyTheVariableName_0(const char *ident, int lengthname) +{ + listvar *newvar; + int out; + + if ( firstpass ) return; + + newvar = List_Global_Var; + out = 0; + while ( newvar && out == 0 ) + { + if ( !strcasecmp(newvar->var->v_nomvar, ident) ) out = 1; + else newvar = newvar->suiv; + } + if ( out == 0 ) + { + newvar = List_ModuleUsed_Var; + while ( newvar && out == 0 ) + { + if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1; + else newvar = newvar->suiv; + } + } + if ( out && !strcasecmp(newvar->var->v_typevar,"type")) return; + + if ( out == 0 ) + { + newvar = List_Common_Var; + while ( newvar && out == 0 ) + { + if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1; + else newvar = newvar->suiv; + } + } + if ( out == 0 ) + { + newvar = List_ModuleUsedInModuleUsed_Var; + while ( newvar && out == 0 ) + { + if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1; + else newvar = newvar->suiv; + } + } + if ( out == 1 && strcasecmp(newvar->var->v_typevar,"type")) + { + // remove the variable + // RemoveWordCUR_0(fortran_out,lengthname); + // then write the new name + // if ( inagrifcallargument == 1 && agrif_parentcall == 0 ) +// fprintf(fortran_out,"%d",newvar->var->v_indicetabvars); +// else +// { +// if ( retour77 == 0 ) +// fprintf(fortran_out,"Agrif_%s & \n ", tabvarsname(newvar->var)); +// else +// { +// fprintf(fortran_out,"Agrif_%s", tabvarsname(newvar->var)); +// fprintf(fortran_out," \n & "); +// } +// fprintf(fortran_out,"%s",vargridcurgridtabvarswithoutAgrif_Gr(newvar->var)); +// } + } + else + { + // we should look in the List_ModuleUsed_Var + if ( inagrifcallargument != 1 ) + { + newvar = List_ModuleUsed_Var; + while ( newvar && out == 0 ) + { + if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1; + else newvar = newvar->suiv; + } + if ( out == 1 && strcasecmp(newvar->var->v_typevar, "type")) + { + // remove the variable + RemoveWordCUR_0(fortran_out,lengthname); + // then write the new name + if ( retour77 == 0 ) + fprintf(fortran_out,"Agrif_%s & \n ",tabvarsname(newvar->var)); + else + { + fprintf(fortran_out," \n &Agrif_%s",tabvarsname(newvar->var)); + } + fprintf(fortran_out,"%s",vargridcurgridtabvarswithoutAgrif_Gr(newvar->var)); + } + } + } +} + +/******************************************************************************/ +/* Add_SubroutineWhereAgrifUsed_1 */ +/******************************************************************************/ +/* This subroutine is used to add a record to */ +/* List_SubroutineWhereAgrifUsed */ +/******************************************************************************/ +/* */ +/* subroutine sub ... Agrif_ */ +/* */ +/* _______ _______ _______ _______ _______ */ +/* + + + + + + + + + + */ +/* + list +--->+ list +--->+ list +--->+ list +--->+ sub + */ +/* +______+ +______+ +______+ +______+ +______+ */ +/* */ +/* list = List_SubroutineWhereAgrifUsed */ +/* */ +/******************************************************************************/ +void Add_SubroutineWhereAgrifUsed_1(const char *sub, const char *mod) +{ + listnom *listnomtmp; + listnom *parcours; + + if ( firstpass == 1 ) + { + if ( !List_SubroutineWhereAgrifUsed ) + { + listnomtmp = (listnom*) calloc(1, sizeof(listnom)); + strcpy(listnomtmp->o_nom, sub); + strcpy(listnomtmp->o_module, mod); + listnomtmp->suiv = NULL; + List_SubroutineWhereAgrifUsed = listnomtmp; + } + else + { + parcours = List_SubroutineWhereAgrifUsed; + while ( parcours && strcasecmp(parcours->o_nom,sub) ) + { + parcours = parcours->suiv; + } + if ( !parcours ) + { + listnomtmp = (listnom*) calloc(1, sizeof(listnom)); + strcpy(listnomtmp->o_nom, sub); + strcpy(listnomtmp->o_module, mod); + listnomtmp->suiv = List_SubroutineWhereAgrifUsed; + List_SubroutineWhereAgrifUsed = listnomtmp; + } + } + } +} + +/******************************************************************************/ +/* AddUseAgrifUtil_0 */ +/******************************************************************************/ +/* Add use Agrif_Util at the beginning of the subroutine definition */ +/* if it is necessary */ +/******************************************************************************/ +/* */ +/* subroutine sub | subroutine sub */ +/* | USE Agrif_Util */ +/* implicit none | implicit none */ +/* ... | ... */ +/* ... Agrif_ | ... Agrif_ */ +/* ... | ... */ +/* end | end */ +/* */ +/* */ +/******************************************************************************/ +void AddUseAgrifUtil_0(FILE *fileout) +{ + listnom *parcours; + + if ( firstpass == 0 ) + { + parcours = List_SubroutineWhereAgrifUsed; + while ( parcours && strcasecmp(parcours->o_nom,subroutinename) ) + { + parcours = parcours -> suiv; + } + if ( parcours && parcours->o_val != 0 ) + fprintf(fileout,"\n use Agrif_Util\n"); + else + fprintf(fileout,"\n use Agrif_Types, only : Agrif_tabvars\n"); + } +} + +void AddUseAgrifUtilBeforeCall_0(FILE *fileout) +{ + listusemodule *parcours; + + int out; + + if ( firstpass == 0 ) + { + parcours = List_NameOfModuleUsed; + out = 0 ; + while ( parcours && out == 0 ) + { + if ( !strcasecmp(parcours->u_usemodule, "Agrif_Util") && + !strcasecmp(parcours->u_modulename, curmodulename) && + !strcasecmp(parcours->u_cursubroutine, subroutinename) ) + out = 1; + else + parcours = parcours->suiv; + } + if ( out == 0 ) + { + fprintf(fileout,"\n use Agrif_Util\n"); + } + } +} + +/******************************************************************************/ +/* NotifyAgrifFunction_0 */ +/******************************************************************************/ +/* Firstpass 0 */ +/******************************************************************************/ +/* */ +/* Agrif_(variable) ====> Agrif_(variable) */ +/* */ +/******************************************************************************/ +void NotifyAgrifFunction_0(const char *ident) +{ + if ( firstpass == 1 ) return; + + if ( !strcasecmp(ident,"Agrif_parent") ) + { + InAgrifParentDef = 1; + pos_curagrifparent = setposcur()-12; + } + else if ( !strcasecmp(ident,"Agrif_Get_Coarse_grid") ) + { + InAgrifParentDef = 2; + pos_curagrifparent = setposcur()-21; + } + else if ( !strcasecmp(ident,"Agrif_Rhox") ) + { + InAgrifParentDef = 3; + pos_curagrifparent = setposcur()-10; + } + else if ( !strcasecmp(ident,"Agrif_Parent_Rhox") ) + { + InAgrifParentDef = 4; + pos_curagrifparent = setposcur()-17; + } + else if ( !strcasecmp(ident,"Agrif_IRhox") ) + { + InAgrifParentDef = 5; + pos_curagrifparent = setposcur()-11; + } + else if ( !strcasecmp(ident,"Agrif_Parent_IRhox") ) + { + InAgrifParentDef = 6; + pos_curagrifparent = setposcur()-18; + } + else if ( !strcasecmp(ident,"Agrif_Rhoy") ) + { + InAgrifParentDef = 7; + pos_curagrifparent = setposcur()-10; + } + else if ( !strcasecmp(ident,"Agrif_Parent_Rhoy") ) + { + InAgrifParentDef = 8; + pos_curagrifparent = setposcur()-17; + } + else if ( !strcasecmp(ident,"Agrif_IRhoy") ) + { + InAgrifParentDef = 9; + pos_curagrifparent = setposcur()-11; + } + else if ( !strcasecmp(ident,"Agrif_Parent_IRhoy") ) + { + InAgrifParentDef = 10; + pos_curagrifparent = setposcur()-18; + } + else if ( !strcasecmp(ident,"Agrif_Rhoz") ) + { + InAgrifParentDef = 11; + pos_curagrifparent = setposcur()-10; + } + else if ( !strcasecmp(ident,"Agrif_Parent_Rhoz") ) + { + InAgrifParentDef = 12; + pos_curagrifparent = setposcur()-17; + } + else if ( !strcasecmp(ident,"Agrif_IRhoz") ) + { + InAgrifParentDef = 13; + pos_curagrifparent = setposcur()-11; + } + else if ( !strcasecmp(ident,"Agrif_Parent_IRhoz") ) + { + InAgrifParentDef = 14; + pos_curagrifparent = setposcur()-18; + } + else if ( !strcasecmp(ident,"Agrif_NearCommonBorderX") ) + { + InAgrifParentDef = 15; + pos_curagrifparent = setposcur()-23; + } + else if ( !strcasecmp(ident,"Agrif_NearCommonBorderY") ) + { + InAgrifParentDef = 16; + pos_curagrifparent = setposcur()-23; + } + else if ( !strcasecmp(ident,"Agrif_NearCommonBorderZ") ) + { + InAgrifParentDef = 17; + pos_curagrifparent = setposcur()-23; + } + else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderX") ) + { + InAgrifParentDef = 18; + pos_curagrifparent = setposcur()-26; + } + else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderY") ) + { + InAgrifParentDef = 19; + pos_curagrifparent = setposcur()-26; + } + else if ( !strcasecmp(ident,"Agrif_DistantCommonBorderZ") ) + { + InAgrifParentDef = 20; + pos_curagrifparent = setposcur()-26; + } + else if ( !strcasecmp(ident,"Agrif_Get_parent_id") ) + { + InAgrifParentDef = 21; + pos_curagrifparent = setposcur()-19; + } + else if ( !strcasecmp(ident,"Agrif_Get_grid_id") ) + { + InAgrifParentDef = 22; + pos_curagrifparent = setposcur()-17; + } + else if ( !strcasecmp(ident,"Agrif_Parent_Iz") ) + { + InAgrifParentDef = 23; + pos_curagrifparent = setposcur()-15; + } + else if ( !strcasecmp(ident,"Agrif_Parent_Iy") ) + { + InAgrifParentDef = 24; + pos_curagrifparent = setposcur()-15; + } + else if ( !strcasecmp(ident,"Agrif_Parent_Ix") ) + { + InAgrifParentDef = 25; + pos_curagrifparent = setposcur()-15; + } + else if ( !strcasecmp(ident,"Agrif_Iz") ) + { + InAgrifParentDef = 26; + pos_curagrifparent = setposcur()-8; + } + else if ( !strcasecmp(ident,"Agrif_Iy") ) + { + InAgrifParentDef = 27; + pos_curagrifparent = setposcur()-8; + } + else if ( !strcasecmp(ident,"Agrif_Ix") ) + { + InAgrifParentDef = 28; + pos_curagrifparent = setposcur()-8; + } + else if ( !strcasecmp(ident,"Agrif_Nb_Fixed_Grids") ) + { + InAgrifParentDef = 29; + pos_curagrifparent = setposcur()-20; + } + else if ( !strcasecmp(ident,"Agrif_Nb_Fine_Grids") ) + { + InAgrifParentDef = 29; + pos_curagrifparent = setposcur()-19; + } + else if ( !strcasecmp(ident,"AGRIF_Nb_Step") ) + { + InAgrifParentDef = 30; + pos_curagrifparent = setposcur()-13; + } +} + +/******************************************************************************/ +/* ModifyTheAgrifFunction_0 */ +/******************************************************************************/ +/* Firstpass 0 */ +/******************************************************************************/ +/* */ +/* Agrif_(variable) ====> Agrif_(variable) */ +/* */ +/******************************************************************************/ +void ModifyTheAgrifFunction_0(const char *ident) +{ + if ( InAgrifParentDef != 0 ) + AgriffunctionModify_0(ident,InAgrifParentDef); + InAgrifParentDef = 0; +} + + +/******************************************************************************/ +/* AgriffunctionModify_0 */ +/******************************************************************************/ +/* Firstpass 0 */ +/******************************************************************************/ +/* if whichone = 1 Agrif_parent ===> */ +/* */ +/* if whichone = 2 Agrif_Get_coarse_grid ===> */ +/* */ +/* if whichone = 3 Agrif_Rhox ===> */ +/* */ +/* if whichone = 4 Agrif_Parent_Rhox ===> */ +/* */ +/* if whichone = 5 Agrif_IRhox ===> */ +/* */ +/* if whichone = 6 Agrif_Parent_IRhox ===> */ +/* */ +/* if whichone = 7 Agrif_Rhoy ===> */ +/* */ +/* if whichone = 8 Agrif_Parent_Rhoy ===> */ +/* */ +/* if whichone = 9 Agrif_IRhoy ===> */ +/* */ +/* if whichone = 10 Agrif_Parent_IRhoy ===> */ +/* */ +/* if whichone = 11 Agrif_Rhoz ===> */ +/* */ +/* if whichone = 12 Agrif_Parent_Rhoz ===> */ +/* */ +/* if whichone = 13 Agrif_IRhoz ===> */ +/* */ +/* if whichone = 14 Agrif_Parent_IRhoz ===> */ +/* */ +/* if whichone = 15 Agrif_NearCommonBorderX ===> */ +/* */ +/* if whichone = 16 Agrif_NearCommonBorderX ===> */ +/* */ +/* if whichone = 17 Agrif_NearCommonBorderX ===> */ +/* */ +/* if whichone = 18 Agrif_DistantCommonBorderX ===> */ +/* */ +/* if whichone = 19 Agrif_DistantCommonBorderY ===> */ +/* */ +/* if whichone = 20 Agrif_DistantCommonBorderZ ===> */ +/* */ +/* if whichone = 21 Agrif_Get_parent_id ===> */ +/* */ +/* if whichone = 22 Agrif_Get_grid_id ===> */ +/* */ +/* if whichone = 23 Agrif_Parent_Iz ===> */ +/* */ +/* if whichone = 24 Agrif_Parent_Iy ===> */ +/* */ +/* if whichone = 25 Agrif_Parent_Ix ===> */ +/* */ +/* if whichone = 26 Agrif_Iz ===> */ +/* */ +/* if whichone = 27 Agrif_Iy ===> */ +/* */ +/* if whichone = 28 Agrif_Ix ===> */ +/* */ +/* if whichone = 29 Agrif_Nb_Fixed_Grids ===> */ +/* */ +/* if whichone = 29 Agrif_Nb_Fine_Grids ===> */ +/* */ +/* if whichone = 30 AGRIF_Nb_Step ===> */ +/* */ +/* */ +/******************************************************************************/ +void AgriffunctionModify_0(const char *ident,int whichone) +{ + char toprint[LONG_M]; + if ( firstpass == 0 ) + { + strcpy(toprint,""); + pos_end = setposcur(); + fseek(fortran_out,pos_curagrifparent,SEEK_SET); + if ( whichone == 1 || whichone == 2 ) + { + FindAndChangeNameToTabvars(ident,toprint,List_Global_Var,1); + if ( !strcasecmp(ident,toprint) ) + { + /* la liste des use de cette subroutine */ + strcpy(toprint,""); + FindAndChangeNameToTabvars(ident,toprint,List_Common_Var,whichone); + } + if ( !strcasecmp(ident,toprint) ) + { + /* la liste des use de cette subroutine */ + strcpy(toprint,""); + FindAndChangeNameToTabvars(ident,toprint,List_ModuleUsed_Var,whichone); + } + } + else if ( whichone == 3 ) /* Agrif_Rhox */ + { + sprintf(toprint,"REAL("); + if( retour77 == 0 ) strcat(toprint," & \n"); + else strcat(toprint,"\n & "); + strcat(toprint,"Agrif_Curgrid % spaceref(1))"); + } + else if ( whichone == 4 ) /* Agrif_Parent_Rhox */ + { + sprintf(toprint,"REAL("); + if( retour77 == 0 ) strcat(toprint," & \n"); + else strcat(toprint,"\n & "); + strcat(toprint,"Agrif_Curgrid % parent % spaceref(1))"); + } + else if ( whichone == 5 ) /* Agrif_Rhox */ + { + sprintf(toprint,"Agrif_Curgrid"); + if( retour77 == 0 ) strcat(toprint," & \n"); + else strcat(toprint,"\n & "); + strcat(toprint,"% spaceref(1)"); + } + else if ( whichone == 6 ) /* Agrif_Parent_Rhox */ + { + sprintf(toprint,"Agrif_Curgrid"); + if( retour77 == 0 ) strcat(toprint," & \n"); + else strcat(toprint,"\n & "); + strcat(toprint,"% parent % spaceref(1)"); + } + else if ( whichone == 7 ) /* Agrif_Rhoy */ + { + sprintf(toprint,"REAL(Agrif_Curgrid"); + if( retour77 == 0 ) strcat(toprint," & \n"); + else strcat(toprint,"\n & "); + strcat(toprint,"% spaceref(2))"); + } + else if ( whichone == 8 ) /* Agrif_Parent_Rhoy */ + { + sprintf(toprint,"REAL(Agrif_Curgrid"); + if( retour77 == 0 ) strcat(toprint," & \n"); + else strcat(toprint,"\n & "); + strcat(toprint,"% parent % spaceref(2))"); + } + else if ( whichone == 9 ) /* Agrif_Rhoy */ + { + sprintf(toprint,"Agrif_Curgrid"); + if( retour77 == 0 ) strcat(toprint," & \n"); + else strcat(toprint,"\n & "); + strcat(toprint,"% spaceref(2)"); + } + else if ( whichone == 10 ) /* Agrif_Parent_Rhoy */ + { + sprintf(toprint,"Agrif_Curgrid"); + if( retour77 == 0 ) strcat(toprint," & \n"); + else strcat(toprint,"\n & "); + strcat(toprint,"% parent % spaceref(2)"); + } + else if ( whichone == 11 ) /* Agrif_Rhoz */ + { + sprintf(toprint,"REAL(Agrif_Curgrid"); + if( retour77 == 0 ) strcat(toprint," & \n"); + else strcat(toprint,"\n & "); + strcat(toprint,"% spaceref(3))"); + } + else if ( whichone == 12 ) /* Agrif_Parent_Rhoz */ + { + sprintf(toprint,"REAL(Agrif_Curgrid"); + if( retour77 == 0 ) strcat(toprint," & \n"); + else strcat(toprint,"\n & "); + strcat(toprint,"% parent % spaceref(3))"); + } + else if ( whichone == 13 ) /* Agrif_Rhoz */ + { + sprintf(toprint,"Agrif_Curgrid"); + if( retour77 == 0 ) strcat(toprint," & \n"); + else strcat(toprint,"\n & "); + strcat(toprint,"% spaceref(3)"); + } + else if ( whichone == 14 ) /* Agrif_Parent_Rhoz */ + { + sprintf(toprint,"Agrif_Curgrid"); + if( retour77 == 0 ) strcat(toprint," & \n"); + else strcat(toprint,"\n & "); + strcat(toprint,"% parent % spaceref(3)"); + } + else if ( whichone == 15 ) /* Agrif_NearCommonBorderX */ + { + sprintf(toprint,"Agrif_Curgrid"); + if( retour77 == 0 ) strcat(toprint," & \n"); + else strcat(toprint,"\n & "); + strcat(toprint,"% NearRootBorder(1)"); + } + else if ( whichone == 16 ) /* Agrif_NearCommonBorderY */ + { + sprintf(toprint,"Agrif_Curgrid"); + if( retour77 == 0 ) strcat(toprint," & \n"); + else strcat(toprint,"\n & "); + strcat(toprint,"% NearRootBorder(2)"); + } + else if ( whichone == 17 ) /* Agrif_NearCommonBorderZ */ + { + sprintf(toprint,"Agrif_Curgrid"); + if( retour77 == 0 ) strcat(toprint," & \n"); + else strcat(toprint,"\n & "); + strcat(toprint,"% NearRootBorder(3)"); + } + else if ( whichone == 18 ) /* Agrif_NearCommonBorderX */ + { + sprintf(toprint,"Agrif_Curgrid"); + if( retour77 == 0 ) strcat(toprint," & \n"); + else strcat(toprint,"\n & "); + strcat(toprint,"% DistantRootBorder(1)"); + } + else if ( whichone == 19 ) /* Agrif_NearCommonBorderY */ + { + sprintf(toprint,"Agrif_Curgrid"); + if( retour77 == 0 ) strcat(toprint," & \n"); + else strcat(toprint,"\n & "); + strcat(toprint,"% DistantRootBorder(2)"); + } + else if ( whichone == 20 ) /* Agrif_NearCommonBorderZ */ + { + sprintf(toprint,"Agrif_Curgrid"); + if( retour77 == 0 ) strcat(toprint," & \n"); + else strcat(toprint,"\n & "); + strcat(toprint,"% DistantRootBorder(3)"); + } + else if ( whichone == 21 ) /* Agrif_Get_parent_id */ + { + sprintf(toprint,"Agrif_Curgrid"); + if( retour77 == 0 ) strcat(toprint," & \n"); + else strcat(toprint,"\n & "); + strcat(toprint,"% parent % grid_id"); + } + else if ( whichone == 22 ) /* Agrif_Get_grid_id */ + { + sprintf(toprint,"Agrif_Curgrid"); + if( retour77 == 0 ) strcat(toprint," & \n"); + else strcat(toprint,"\n & "); + strcat(toprint,"% grid_id"); + } + else if ( whichone == 23 ) /* Agrif_Parent_Iz */ + { + sprintf(toprint,"Agrif_Curgrid"); + if( retour77 == 0 ) strcat(toprint," & \n"); + else strcat(toprint,"\n & "); + strcat(toprint,"% parent % ix(3)"); + } + else if ( whichone == 24 ) /* Agrif_Parent_Iy */ + { + sprintf(toprint,"Agrif_Curgrid"); + if( retour77 == 0 ) strcat(toprint," & \n"); + else strcat(toprint,"\n & "); + strcat(toprint,"% parent % ix(2)"); + } + else if ( whichone == 25 ) /* Agrif_Parent_Ix */ + { + sprintf(toprint,"Agrif_Curgrid"); + if( retour77 == 0 ) strcat(toprint," & \n"); + else strcat(toprint,"\n & "); + strcat(toprint,"% parent % ix(1)"); + } + else if ( whichone == 26 ) /* Agrif_Iz */ + { + sprintf(toprint,"Agrif_Curgrid"); + if( retour77 == 0 ) strcat(toprint," & \n"); + else strcat(toprint,"\n & "); + strcat(toprint," % ix(3)"); + } + else if ( whichone == 27 ) /* Agrif_Iy */ + { + sprintf(toprint,"Agrif_Curgrid"); + if( retour77 == 0 ) strcat(toprint," & \n"); + else strcat(toprint,"\n & "); + strcat(toprint,"% ix(2)"); + } + else if ( whichone == 28 ) /* Agrif_Ix */ + { + sprintf(toprint,"Agrif_Curgrid"); + if( retour77 == 0 ) strcat(toprint," & \n"); + else strcat(toprint,"\n & "); + strcat(toprint,"% ix(1)"); + } + else if ( whichone == 29 ) /* Agrif_Nb_Fixed_Grids */ + { + sprintf(toprint,"Agrif_nbfixedgrids"); + } + else if ( whichone == 30 ) /* AGRIF_Nb_Step */ + { + sprintf(toprint,"Agrif_Curgrid"); + if( retour77 == 0 ) strcat(toprint," & \n"); + else strcat(toprint,"\n & "); + strcat(toprint,"% ngridstep"); + } + + Save_Length(toprint,43); + + if ( whichone == 1 || whichone == 2 ) tofich(fortran_out,toprint,0); + else fprintf(fortran_out,"%s",toprint); + } +} + +/******************************************************************************/ +/* Instanciation_0 */ +/******************************************************************************/ +/* Firstpass 0 */ +/******************************************************************************/ +/* */ +/* Agrif_(variable) ====> Agrif_(variable) */ +/* */ +/******************************************************************************/ +void Instanciation_0(const char *ident) +{ + listvar *newvar; + int out; + + if ( firstpass == 0 && sameagrifargument == 1 ) + { + newvar = List_Global_Var; + out = 0; + while ( newvar && out == 0 ) + { + if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1; + else newvar = newvar->suiv; + } + if ( out == 0 ) + { + newvar = List_Common_Var; + while ( newvar && out == 0 ) + { + if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1; + else newvar = newvar->suiv; + } + } + if ( out == 0 ) + { + newvar = List_ModuleUsed_Var; + while ( newvar && out == 0 ) + { + if ( !strcasecmp(newvar->var->v_nomvar,ident) ) out = 1; + else newvar = newvar->suiv; + } + } +// if ( out == 1 ) +// { +// /* then write the instanciation */ +// fprintf(fortran_out,"\n %s = %s",ident,vargridcurgridtabvars(newvar->var,3)); +// printf("#\n# Instanciation_0: |%s = %s|\n#\n", ident,vargridcurgridtabvars(newvar->var,3)); +// } + } + sameagrifargument = 0; +} diff --git a/CROCO/croco-v1.3.1/AGRIF/LIB/UtilCharacter.c b/CROCO/croco-v1.3.1/AGRIF/LIB/UtilCharacter.c new file mode 100644 index 00000000..a6731b20 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/LIB/UtilCharacter.c @@ -0,0 +1,387 @@ +/******************************************************************************/ +/* */ +/* CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran) */ +/* */ +/* Copyright or or Copr. Laurent Debreu (Laurent.Debreu@imag.fr) */ +/* Cyril Mazauric (Cyril_Mazauric@yahoo.fr) */ +/* This software is governed by the CeCILL-C license under French law and */ +/* abiding by the rules of distribution of free software. You can use, */ +/* modify and/ or redistribute the software under the terms of the CeCILL-C */ +/* license as circulated by CEA, CNRS and INRIA at the following URL */ +/* "http://www.cecill.info". */ +/* */ +/* As a counterpart to the access to the source code and rights to copy, */ +/* modify and redistribute granted by the license, users are provided only */ +/* with a limited warranty and the software's author, the holder of the */ +/* economic rights, and the successive licensors have only limited */ +/* liability. */ +/* */ +/* In this respect, the user's attention is drawn to the risks associated */ +/* with loading, using, modifying and/or developing or reproducing the */ +/* software by the user in light of its specific status of free software, */ +/* that may mean that it is complicated to manipulate, and that also */ +/* therefore means that it is reserved for developers and experienced */ +/* professionals having in-depth computer knowledge. Users are therefore */ +/* encouraged to load and test the software's suitability as regards their */ +/* requirements in conditions enabling the security of their systems and/or */ +/* data to be ensured and, more generally, to use and operate it in the */ +/* same conditions as regards security. */ +/* */ +/* The fact that you are presently reading this means that you have had */ +/* knowledge of the CeCILL-C license and that you accept its terms. */ +/******************************************************************************/ +/* version 1.7 */ +/******************************************************************************/ +#include +#include +#include +#include "decl.h" + + + + +/******************************************************************************/ +/* FindAndChangeNameToTabvars */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +/* if whichone = 0 ----> Agrif_tabvars(i) % array2 */ +/* */ +/* if whichone = 1 ----> Agrif_tabvars(i) % parentvar % array2 */ +/* */ +/******************************************************************************/ +void FindAndChangeNameToTabvars(const char name[LONG_M],char toprint[LONG_M], + listvar * listtosee, int whichone) +{ + listvar *newvar; + int out; + + + if ( strcasecmp(name,"") ) + { + newvar=listtosee; + out=0; + while( newvar && out == 0 ) + { + if ( !strcasecmp(newvar->var->v_nomvar,name) ) + { + + if ( LookingForVariableInListName( + List_SubroutineArgument_Var,name) == 0 ) + { + out = 1; + strcat(toprint,vargridcurgridtabvars(newvar->var, whichone)); + } + else newvar=newvar->suiv; + } + else newvar=newvar->suiv; + } + if ( out == 0 ) strcat(toprint,name); + } + Save_Length(toprint,44); +} + + +/******************************************************************************/ +/* ChangeTheInitalvaluebyTabvarsName */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +/* */ +/* */ +/* */ +/******************************************************************************/ +const char *ChangeTheInitalvaluebyTabvarsName(const char *nom, listvar *listtoread) +{ + char toprinttmp[LONG_M]; + char chartmp[2]; + size_t i = 0; + + strcpy(toprintglob, ""); + strcpy(toprinttmp, ""); + + while ( i < strlen(nom) ) + { + if ( (nom[i] == '+') || (nom[i] == '-') || (nom[i] == '*') || (nom[i] == '/') || + (nom[i] == '(') || (nom[i] == ')') || (nom[i] == ':') || (nom[i] == ',') ) + { + FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,0); + strcpy(toprinttmp, ""); + sprintf(chartmp, "%c", nom[i]); + strcat(toprintglob, chartmp); + } + else + { + sprintf(chartmp, "%c", nom[i]); + strcat(toprinttmp, chartmp); + } + i += 1; + } + FindAndChangeNameToTabvars(toprinttmp,toprintglob,listtoread,0); + strcpy(toprinttmp,""); + + Save_Length(toprinttmp,44); + Save_Length(toprintglob,39); + + return toprintglob; +} + +/******************************************************************************/ +/* IsVariableReal */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +/* */ +/* */ +/* */ +/******************************************************************************/ +int IsVariableReal(const char *nom) +{ + return ( ( nom[0] >= 'a' && nom[0] <= 'h' ) || + ( nom[0] >= 'A' && nom[0] <= 'H' ) || + ( nom[0] >= 'o' && nom[0] <= 'z' ) || + ( nom[0] >= 'O' && nom[0] <= 'Z' ) ); +} +/******************************************************************************/ +/* IsVarInUseFile */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +/* */ +/* */ +/* */ +/******************************************************************************/ +void IsVarInUseFile(const char *nom) +{ + listvar *parcours; + listparameter *parcoursparam; + int out; + + out = 0; + + parcours = List_Global_Var; + while( parcours && out == 0 ) + { + if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out = 1 ; + else parcours=parcours->suiv; + } + if ( out == 0 ) + { + parcours = List_Common_Var; + while( parcours && out == 0 ) + { + if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out = 1 ; + else parcours=parcours->suiv; + } + } + if ( out == 0 ) + { + parcours = List_GlobalParameter_Var; + while( parcours && out == 0 ) + { + if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out =1 ; + else parcours=parcours->suiv; + } + } + if ( out == 0 ) + { + parcours = List_Parameter_Var; + while( parcours && out == 0 ) + { + if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out = 1 ; + else parcours=parcours->suiv; + } + } + if ( out == 0 ) + { + parcoursparam = List_GlobParamModuleUsed_Var; + while( parcoursparam && out == 0 ) + { + if ( !strcasecmp(nom,parcoursparam->p_name) ) out = 2 ; + else parcoursparam=parcoursparam->suiv; + } + } + if ( out == 0 ) + { + parcours = List_ModuleUsed_Var; + while( parcours && out == 0 ) + { + if ( !strcasecmp(nom,parcours->var->v_nomvar) ) out = 2 ; + else parcours=parcours->suiv; + } + } + if ( out == 0 || out == 2 ) + { + parcoursparam = List_GlobParamModuleUsedInModuleUsed_Var; + while( parcoursparam && out != 1 ) + { + if ( !strcasecmp(nom,parcoursparam->p_name) ) out = 1 ; + else parcoursparam=parcoursparam->suiv; + } + if ( out == 1 ) + { + strcpy(charusemodule,parcoursparam->p_modulename); + Addmoduletothelist(parcoursparam->p_modulename); + } + } + if ( out == 0 && + strcasecmp(nom,"MAX") && + strcasecmp(nom,"mpi_status_size") + ) + { + /* printf("--- in UtilCharacter we do not found the \n"); + printf("--- variable %s, the module where this \n",nom); + printf("--- variable has been defined has not been\n"); + printf("--- found.\n");*/ + } +} + +/******************************************************************************/ +/* DecomposeTheNameinlistnom */ +/******************************************************************************/ +/* Firstpass 0 */ +/******************************************************************************/ +/* */ +/* */ +/******************************************************************************/ +listnom *DecomposeTheNameinlistnom(const char *nom, listnom * listout) +{ + char toprinttmp[LONG_M]; + char chartmp[2]; + size_t i = 0; + + strcpy(toprinttmp,""); + + while ( i < strlen(nom) ) + { + if ( nom[i] == '+' || + nom[i] == '-' || + nom[i] == '*' || + nom[i] == '/' || + nom[i] == ')' || + nom[i] == '(' || + nom[i] == ',' || + nom[i] == ':' + ) + { + if (strcasecmp(toprinttmp,"") && ( toprinttmp[0] >= 'A' ) ) + { + listout = Addtolistnom(toprinttmp,listout,0); + } + strcpy(toprinttmp,""); + } + else + { + sprintf(chartmp,"%c",nom[i]); + strcat(toprinttmp,chartmp); + } + i=i+1; + } + if (strcasecmp(toprinttmp,"") && ( toprinttmp[0] >= 'A' ) ) + { + listout = Addtolistnom(toprinttmp,listout,0); + } + Save_Length(toprinttmp,44); + strcpy(toprinttmp,""); + + return listout; +} + + +/******************************************************************************/ +/* DecomposeTheName */ +/******************************************************************************/ +/* Firstpass 0 */ +/******************************************************************************/ +/* */ +/* Agrif_(variable) ====> Agrif_(variable) */ +/* */ +/******************************************************************************/ +void DecomposeTheName(const char *nom) +{ + char toprinttmp[LONG_M]; + char chartmp[2]; + size_t i = 0; + + strcpy(toprinttmp,""); + + while ( i < strlen(nom) ) + { + if ( nom[i] == '+' || + nom[i] == '-' || + nom[i] == '*' || + nom[i] == '/' || + nom[i] == ')' || + nom[i] == '(' || + nom[i] == ',' || + nom[i] == ':' + ) + { + if (strcasecmp(toprinttmp,"") && ( toprinttmp[0] >= 'A' ) ) + { + ajoutevarindoloop_definedimension (toprinttmp); + /* Is this variable present in globvarofusefile */ + IsVarInUseFile(toprinttmp); + } + strcpy(toprinttmp,""); + } + else + { + sprintf(chartmp,"%c",nom[i]); + strcat(toprinttmp,chartmp); + } + i=i+1; + } + if (strcasecmp(toprinttmp,"") && ( toprinttmp[0] >= 'A' ) ) + { + ajoutevarindoloop_definedimension (toprinttmp); + /* Is this variable present in globvarofusefile */ + IsVarInUseFile(toprinttmp); + } + Save_Length(toprinttmp,44); + strcpy(toprinttmp,""); + +} + +void convert2lower(char *lowername, const char* inputname) +{ + int i, l, caractere; + + strcpy(lowername, inputname); + l = strlen(lowername)-1; + + for ( i=0 ; i<=l ; i++) + { + caractere = lowername[i]; + if ( (caractere>=65 && caractere<=90) || (caractere>=192 && caractere<=221) ) + { + lowername[i] += 32; + } + } +} + +int convert2int(const char *name) +{ + int i; + int caractere; + int value; + int value_tmp; + int longueur; + + value = 0; + + longueur = strlen(name) - 1; + for (i=0;i<=longueur;i++) + { + caractere=name[i]; + value_tmp = caractere -'0'; + if ( value_tmp > 9 ) return 0; + if ( longueur+1-i == 6 ) value = value + value_tmp *100000; + else if ( longueur+1-i == 5 ) value = value + value_tmp *10000; + else if ( longueur+1-i == 4 ) value = value + value_tmp *1000; + else if ( longueur+1-i == 3 ) value = value + value_tmp *100; + else if ( longueur+1-i == 2 ) value = value + value_tmp *10; + else if ( longueur+1-i == 1 ) value = value + value_tmp *1; + } + return value; +} diff --git a/CROCO/croco-v1.3.1/AGRIF/LIB/UtilFile.c b/CROCO/croco-v1.3.1/AGRIF/LIB/UtilFile.c new file mode 100644 index 00000000..8bbd6dc7 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/LIB/UtilFile.c @@ -0,0 +1,128 @@ +/******************************************************************************/ +/* */ +/* CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran) */ +/* */ +/* Copyright or or Copr. Laurent Debreu (Laurent.Debreu@imag.fr) */ +/* Cyril Mazauric (Cyril_Mazauric@yahoo.fr) */ +/* This software is governed by the CeCILL-C license under French law and */ +/* abiding by the rules of distribution of free software. You can use, */ +/* modify and/ or redistribute the software under the terms of the CeCILL-C */ +/* license as circulated by CEA, CNRS and INRIA at the following URL */ +/* "http://www.cecill.info". */ +/* */ +/* As a counterpart to the access to the source code and rights to copy, */ +/* modify and redistribute granted by the license, users are provided only */ +/* with a limited warranty and the software's author, the holder of the */ +/* economic rights, and the successive licensors have only limited */ +/* liability. */ +/* */ +/* In this respect, the user's attention is drawn to the risks associated */ +/* with loading, using, modifying and/or developing or reproducing the */ +/* software by the user in light of its specific status of free software, */ +/* that may mean that it is complicated to manipulate, and that also */ +/* therefore means that it is reserved for developers and experienced */ +/* professionals having in-depth computer knowledge. Users are therefore */ +/* encouraged to load and test the software's suitability as regards their */ +/* requirements in conditions enabling the security of their systems and/or */ +/* data to be ensured and, more generally, to use and operate it in the */ +/* same conditions as regards security. */ +/* */ +/* The fact that you are presently reading this means that you have had */ +/* knowledge of the CeCILL-C license and that you accept its terms. */ +/******************************************************************************/ +/* version 1.7 */ +/******************************************************************************/ +#include +#include +#include +#include "decl.h" + + +/******************************************************************************/ +/* open_for_write */ +/******************************************************************************/ +/* This subroutine is used to open a file */ +/******************************************************************************/ +FILE* open_for_write (const char *filename) +{ + char filefich[LONG_FNAME]; + sprintf(filefich,"%s/%s",include_dir,filename); + return fopen(filefich, "w"); +} + +/******************************************************************************/ +/* open_for_append */ +/******************************************************************************/ +/* This subroutine is used to open a file with option a+ */ +/******************************************************************************/ +FILE* open_for_append (const char *filename) +{ + char filefich[LONG_M]; + sprintf(filefich,"%s/%s",include_dir,filename); + return fopen(filefich, "a+"); +} + +/******************************************************************************/ +/* setposcurname */ +/******************************************************************************/ +/* This subroutine is used to know the current position in the file in argument */ +/******************************************************************************/ +/* */ +/* setposcur ---------> position in file */ +/* */ +/******************************************************************************/ +long int setposcurname(FILE *fileout) +{ + fflush(fileout); + return ftell(fileout); +} + +/******************************************************************************/ +/* setposcur */ +/******************************************************************************/ +/* This subroutine is used to know the current position in the file */ +/******************************************************************************/ +/* */ +/* setposcur ---------> position in file */ +/* */ +/******************************************************************************/ +long int setposcur() +{ + return setposcurname(fortran_out); +} + +/******************************************************************************/ +/* copyuse_0 */ +/******************************************************************************/ +/* Firstpass 0 */ +/* We should write in the fortran_out the USE tok_name */ +/* read in the original file */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +void copyuse_0(const char *namemodule) +{ + if ( IsTabvarsUseInArgument_0() == 1 ) + { + /* We should write this declaration into the original subroutine too */ + fprintf(oldfortran_out," use %s\n", namemodule); + } +} + +/******************************************************************************/ +/* copyuseonly_0 */ +/******************************************************************************/ +/* Firstpass 0 */ +/* We should write in the fortran_out the USE tok_name, only */ +/* read in the original file */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +void copyuseonly_0(const char *namemodule) +{ + if (firstpass == 0 && IsTabvarsUseInArgument_0() == 1 ) + { + /* We should write this declaration into the original subroutine too */ + fprintf(oldfortran_out," use %s , only : \n", namemodule); + } +} diff --git a/CROCO/croco-v1.3.1/AGRIF/LIB/UtilFortran.c b/CROCO/croco-v1.3.1/AGRIF/LIB/UtilFortran.c new file mode 100644 index 00000000..598c6d67 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/LIB/UtilFortran.c @@ -0,0 +1,675 @@ +/******************************************************************************/ +/* */ +/* CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran) */ +/* */ +/* Copyright or or Copr. Laurent Debreu (Laurent.Debreu@imag.fr) */ +/* Cyril Mazauric (Cyril_Mazauric@yahoo.fr) */ +/* This software is governed by the CeCILL-C license under French law and */ +/* abiding by the rules of distribution of free software. You can use, */ +/* modify and/ or redistribute the software under the terms of the CeCILL-C */ +/* license as circulated by CEA, CNRS and INRIA at the following URL */ +/* "http://www.cecill.info". */ +/* */ +/* As a counterpart to the access to the source code and rights to copy, */ +/* modify and redistribute granted by the license, users are provided only */ +/* with a limited warranty and the software's author, the holder of the */ +/* economic rights, and the successive licensors have only limited */ +/* liability. */ +/* */ +/* In this respect, the user's attention is drawn to the risks associated */ +/* with loading, using, modifying and/or developing or reproducing the */ +/* software by the user in light of its specific status of free software, */ +/* that may mean that it is complicated to manipulate, and that also */ +/* therefore means that it is reserved for developers and experienced */ +/* professionals having in-depth computer knowledge. Users are therefore */ +/* encouraged to load and test the software's suitability as regards their */ +/* requirements in conditions enabling the security of their systems and/or */ +/* data to be ensured and, more generally, to use and operate it in the */ +/* same conditions as regards security. */ +/* */ +/* The fact that you are presently reading this means that you have had */ +/* knowledge of the CeCILL-C license and that you accept its terms. */ +/******************************************************************************/ +/* version 1.7 */ +/******************************************************************************/ +#include +#include +#include +#include "decl.h" + +/******************************************************************************/ +/* initdimprob */ +/******************************************************************************/ +/* This subroutine is used to initialized grid dimension variable */ +/******************************************************************************/ +void initdimprob(int dimprobmod, const char * nx, const char * ny, const char* nz) +{ + dimprob = dimprobmod; + + strcpy(nbmaillesX, nx); + strcpy(nbmaillesY, ny); + strcpy(nbmaillesZ, nz); +} + +/******************************************************************************/ +/* Variableshouldberemoved */ +/******************************************************************************/ +/* Firstpass 0 */ +/******************************************************************************/ +/* */ +/* Agrif_(variable) ====> Agrif_(variable) */ +/* */ +/******************************************************************************/ +int Variableshouldberemoved(const char *nom) +{ + return Agrif_in_Tok_NAME(nom); +} + +/******************************************************************************/ +/* variableisglobal */ +/******************************************************************************/ +/* This subroutine is to know if a variable is global */ +/******************************************************************************/ +int variableisglobal(listvar *curvar, listvar *listin) +{ + int Globalite; + listvar *newvar; + + + Globalite = 0; + newvar = listin; + while ( newvar && Globalite == 0 ) + { + if ( !strcasecmp(newvar->var->v_nomvar,curvar->var->v_nomvar) ) + { + Globalite = 1; + /* Now we should give the definition of the variable in the */ + /* table List_UsedInSubroutine_Var */ + strcpy(curvar->var->v_typevar, newvar->var->v_typevar); + strcpy(curvar->var->v_dimchar, newvar->var->v_dimchar); + curvar->var->v_nbdim = newvar->var->v_nbdim; + curvar->var->v_dimensiongiven = newvar->var->v_dimensiongiven; + curvar->var->v_allocatable = newvar->var->v_allocatable; + curvar->var->v_target = newvar->var->v_target; + curvar->var->v_catvar = newvar->var->v_catvar; + curvar->var->v_pointerdeclare = newvar->var->v_pointerdeclare; + curvar->var->v_indicetabvars = newvar->var->v_indicetabvars; + strcpy(curvar->var->v_nameinttypename, newvar->var->v_nameinttypename); + strcpy(curvar->var->v_precision, newvar->var->v_precision); + strcpy(curvar->var->v_readedlistdimension, newvar->var->v_readedlistdimension); + strcpy(curvar->var->v_commoninfile, newvar->var->v_commoninfile); + } + else + { + newvar = newvar->suiv; + } + } + + return Globalite ; +} + +int VariableIsInListCommon(listvar *curvar,listvar *listin) +{ + int present; + listvar *newvar; + + present = 0; + newvar = listin; + + while ( newvar && present == 0 ) + { + if ( !strcasecmp(newvar->var->v_nomvar,curvar->var->v_nomvar) && + !strcasecmp(newvar->var->v_subroutinename, curvar->var->v_subroutinename) ) + { + strcpy(curvar->var->v_commoninfile,newvar->var->v_commoninfile); + Merge_Variables(curvar->var,newvar->var); + present = 1; + } + else newvar = newvar->suiv; + } + + return present; +} + +int VariableIsInList(listvar *curvar,listvar *listin) +{ + int present; + listvar *newvar; + + present = 0; + newvar = listin; + while ( newvar && present == 0 ) + { + if ( !strcasecmp(newvar->var->v_nomvar,curvar->var->v_nomvar) ) + { + Merge_Variables(curvar->var,newvar->var); + present = 1; + } + else newvar = newvar->suiv; + } + + return present; +} + +/******************************************************************************/ +/* variableisglobalinmodule */ +/******************************************************************************/ +/* This subroutine is to know if a variable is global */ +/******************************************************************************/ +void variableisglobalinmodule(listcouple *listin, const char *module, FILE *fileout, long int oldposcuruse) +{ + int Globalite; + listcouple *newvar; + listcouple *newvarprec; + listvar *tempo; + listvar *newvar2; + int out; + char truename[LONG_VNAME]; + + Globalite = 1; + newvarprec = (listcouple *)NULL; + tempo = (listvar *)NULL; + tempo = Readthedependfile(module,tempo); + newvar = listin; + + while ( newvar ) + { + if (!strcmp(newvar->c_namepointedvar,"")) { + strcpy(truename,newvar->c_namevar); + } + else + { + strcpy(truename,newvar->c_namepointedvar); + } + + out = 0; + newvar2 = tempo; + while ( newvar2 && out == 0 ) + { + if ( !strcasecmp(newvar2->var->v_nomvar,truename) ) out = 1; + else newvar2 = newvar2 ->suiv; + } + if ( out == 1 ) + { + /* remove from the listin */ + if ( newvar == listin ) + { + listin = listin->suiv; + newvar = listin; + } + else + { + newvarprec->suiv = newvar->suiv; + newvar = newvar->suiv; + } + } + else + { + newvarprec = newvar; + newvar = newvar->suiv; + Globalite = 0; + } + } + if ( Globalite == 0 || !newvar) + { + pos_end = setposcurname(fileout); + RemoveWordSET_0(fileout,oldposcuruse,pos_end-oldposcuruse); + + newvar = listin; + while ( newvar ) + { + fprintf(fileout," use %s, only : %s \n",module,newvar->c_namevar); + newvar = newvar->suiv; + } + } +} + +void Write_Word_end_module_0() +{ + if ( firstpass == 0 ) + { + fprintf(fortran_out,"\n end module %s",curmodulename); + } +} + +void Add_Subroutine_For_Alloc(const char *nom) +{ + listnom *parcours; + listnom *newvar; + int out; + + newvar = (listnom*) calloc(1, sizeof(listnom)); + strcpy(newvar->o_nom,nom); + newvar->suiv = NULL; + + if ( !List_Subroutine_For_Alloc ) + { + List_Subroutine_For_Alloc = newvar; + } + else + { + parcours = List_Subroutine_For_Alloc; + out = 0 ; + while ( parcours->suiv && out == 0 ) + { + if ( !strcasecmp(parcours->o_nom,nom) ) out = 1 ; + else parcours = parcours ->suiv; + } + /* */ + if ( out == 0 ) + { + if ( strcasecmp(parcours->o_nom,nom) ) parcours->suiv = newvar; + } + } +} + +void Write_Closing_Module(int forend) +{ + listvar *parcours; + listnom *parcours_nom; + listnom *parcours_nomprec; + variable *v; + int out = 0; + int headtypewritten = 0; + char ligne[LONG_M]; + int changeval; + + // Write Global Parameter Declaration + parcours = List_GlobalParameter_Var; + while( parcours ) + { + if ( !strcasecmp(parcours->var->v_modulename, curmodulename) ) + { + WriteVarDeclaration(parcours->var, module_declar, 0, 1); + } + parcours = parcours -> suiv; + } + + // Write Global Type declaration + parcours = List_Global_Var; + while( parcours ) + { + v = parcours->var; + if ( !strcasecmp(v->v_modulename, curmodulename) && + !strcasecmp(v->v_typevar, "type") ) + { + if ( headtypewritten == 0 ) + { + fprintf(fortran_out, "\n type Agrif_%s\n", curmodulename); + headtypewritten = 1; + } + changeval = 0; + if ( v->v_allocatable ) + { + changeval = 1; + v->v_allocatable = 0; + v->v_pointerdeclare = 1; + } + WriteVarDeclaration(v, fortran_out, 0, 0); + if ( changeval ) + { + v->v_allocatable = 1; + v->v_pointerdeclare = 0; + } + out = 1; + } + parcours = parcours -> suiv; + } + if (out == 1) + { + fprintf(fortran_out, " end type Agrif_%s\n", curmodulename); + sprintf(ligne, "type(Agrif_%s), dimension(:), allocatable :: Agrif_%s_var",curmodulename, curmodulename); + tofich(fortran_out,ligne,1); + fprintf(fortran_out, " public :: Agrif_%s\n", curmodulename); + fprintf(fortran_out, " public :: Agrif_%s_var\n", curmodulename); + } + + // Write NotGridDepend declaration + parcours = List_NotGridDepend_Var; + while( parcours ) + { + if ( !strcasecmp(parcours->var->v_modulename,curmodulename) ) + { + WriteVarDeclaration(parcours->var, fortran_out, 0, 1); + } + parcours = parcours -> suiv; + } + + // Write Alloc_agrif_'modulename' subroutine + parcours_nomprec = (listnom*) NULL; + parcours_nom = List_NameOfModule; + out = 0 ; + while ( parcours_nom && out == 0 ) + { + if ( !strcasecmp(curmodulename,parcours_nom->o_nom) ) out = 1; + else parcours_nom = parcours_nom -> suiv; + } + if ( ! out ) + { + printf("#\n# Write_Closing_Module : OUT == 0 *** /!\\ ***\n"); + printf("# FIXME: POSSIBLE BUG in CONV !!!\n#\n"); + } + if ( out ) + { + if ( parcours_nom->o_val == 1 ) + { + fprintf(fortran_out,"\n public :: Alloc_agrif_%s\n",curmodulename); + } + if ( (forend == 0) || (parcours_nom->o_val == 1) ) + { + fprintf(fortran_out,"\n contains\n"); + } + if ( parcours_nom->o_val == 1 ) + { + fprintf(fortran_out, " subroutine Alloc_agrif_%s(Agrif_Gr)\n", curmodulename); + fprintf(fortran_out, " use Agrif_Util\n"); + fprintf(fortran_out, " type(Agrif_grid), pointer :: Agrif_Gr\n"); + fprintf(fortran_out, " integer :: i\n"); + fprintf(fortran_out, "\n#include \"alloc_agrif_%s.h\"\n", curmodulename); + fprintf(fortran_out, " end subroutine Alloc_agrif_%s\n", curmodulename); + Add_Subroutine_For_Alloc(curmodulename); + } + else + { + parcours_nom = List_Subroutine_For_Alloc; + out = 0; + while ( parcours_nom && out == 0 ) + { + if ( !strcasecmp(parcours_nom->o_nom, curmodulename) ) out = 1; + else + { + parcours_nomprec = parcours_nom; + parcours_nom = parcours_nom->suiv; + } + } + if ( out ) + { + if ( parcours_nom == List_Subroutine_For_Alloc) + { + List_Subroutine_For_Alloc = List_Subroutine_For_Alloc->suiv; + } + else + { + parcours_nomprec->suiv = parcours_nom->suiv; + parcours_nom = parcours_nomprec->suiv ; + } + } + } + } +} + +/******************************************************************************/ +/* IsTabvarsUseInArgument_0 */ +/******************************************************************************/ +/* Firstpass 1 */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +int IsTabvarsUseInArgument_0() +{ + int out; + int doloopout; + listvar *parcours; + + out=1; + + if ( List_UsedInSubroutine_Var ) + { + doloopout = 0; + parcours = List_UsedInSubroutine_Var; + while ( parcours && doloopout == 0 ) + { + if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) ) + doloopout = 1; + else parcours = parcours->suiv; + + } + if ( doloopout == 0 ) out = 0; + else out = 1 ; + } + else out = 0; + + return out; +} + + +/******************************************************************************/ +/* ImplicitNoneInSubroutine */ +/******************************************************************************/ +/* Firstpass 0 */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +int ImplicitNoneInSubroutine() +{ + listname *parcours; + int out; + + parcours= List_ImplicitNoneSubroutine; + out = 0 ; + while ( parcours && out == 0 ) + { + if ( !strcasecmp(parcours->n_name,subroutinename) ) out = 1; + else parcours = parcours->suiv; + } + return out; +} + +/******************************************************************************/ +/* Add_Pointer_Var_From_List_1 */ +/******************************************************************************/ +/* Firstpass 1 */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +void Add_Pointer_Var_From_List_1(listvar *listin) +{ + listvar *parcours; + + if ( firstpass == 1 ) + { + parcours = listin; + while ( parcours ) + { + Add_Pointer_Var_1(parcours->var->v_nomvar); + parcours = parcours -> suiv ; + } + } +} + +/******************************************************************************/ +/* Add_Pointer_Var_1 */ +/******************************************************************************/ +/* Firstpass 1 */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +void Add_Pointer_Var_1(char *nom) +{ + listname *newvar; + listname *parcours; + int out; + + if ( firstpass == 1 ) + { + if ( !List_Pointer_Var ) + { + newvar = (listname*) calloc(1, sizeof(listname)); + strcpy(newvar->n_name, nom); + newvar->suiv = NULL; + List_Pointer_Var = newvar; + } + else + { + parcours = List_Pointer_Var; + out = 0 ; + while ( parcours->suiv && out == 0 ) + { + if ( !strcasecmp(parcours->n_name,nom) ) out = 1; + else + parcours=parcours->suiv; + } + if ( out == 0 ) + { + if ( !strcasecmp(parcours->n_name,nom) ) out = 1; + else + { + /* add the record */ + newvar = (listname*) calloc(1, sizeof(listname)); + strcpy(newvar->n_name,nom); + newvar->suiv = NULL; + parcours->suiv = newvar; + } + } + } + } +} + +/******************************************************************************/ +/* varispointer_0 */ +/******************************************************************************/ +/* Firstpass 0 */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +int varispointer_0(char *ident) +{ + listname *newname; + int out; + + out =0; + if ( firstpass == 0 ) + { + newname = List_Pointer_Var; + while( newname && out == 0 ) + { + if ( !strcasecmp(ident,newname->n_name) ) out = 1 ; + else newname = newname->suiv; + } + } + return out; +} + +/******************************************************************************/ +/* varistyped_0 */ +/******************************************************************************/ +/* Firstpass 0 */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +int varistyped_0(char *ident) +{ + listvar *parcours; + int out; + + out =0; + if ( firstpass == 0 ) + { + parcours = List_Global_Var; + while( parcours && out == 0 ) + { + if ( !strcasecmp(ident,parcours->var->v_nomvar) ) + { + if (!strcasecmp(parcours->var->v_typevar,"type")) out = 1; + } + parcours = parcours->suiv; + } + } + return out; +} + + +/******************************************************************************/ +/* VariableIsFunction */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +int VariableIsFunction(const char *ident) +{ + int out; + listvar *newvar; + + out = 0; + + return (out == 0); + + if ( !strcasecmp(ident,"size") || + !strcasecmp(ident,"if") || + !strcasecmp(ident,"max") || + !strcasecmp(ident,"min") ) + { + printf("ident = %s\n",ident); + newvar = List_SubroutineDeclaration_Var; + while ( newvar && out == 0 ) + { + if ( !strcasecmp(subroutinename, newvar->var->v_subroutinename) && + !strcasecmp(ident, newvar->var->v_nomvar) ) + { + out = 1; + } + newvar = newvar -> suiv ; + } + if ( out == 0 ) /* if it has not been found */ + { + newvar = List_Global_Var; + while ( newvar && out == 0 ) + { + printf("llll = %s\n",newvar->var->v_nomvar); + if ( !strcasecmp(ident, newvar->var->v_nomvar) ) out = 1; + newvar = newvar -> suiv ; + } + } + } + return (out == 0); +} + +/* removenewline */ +/* REMOVE UNWANTED character */ +/* from a NAME{NEWLINE77]NAME flex match */ + +void removenewline(char *nom) +{ +char temp_nom[LONG_VNAME]; +int size_nom,i,j; + +size_nom=strlen(nom); + +j=0; +for (i=0;iv_nomvar : %s\n",var->v_nomvar); + fprintf(stderr, " var->v_indice : %d\n",var->v_indicetabvars); + fprintf(stderr, " var->v_typevar: %s\n",var->v_typevar); + fprintf(stderr, " var->v_catvar : %d\n",var->v_catvar); + fprintf(stderr, " var->v_modulename: %s\n",var->v_modulename); + fprintf(stderr, " var->v_subroutinename: %s\n",var->v_subroutinename); + fprintf(stderr, " var->v_commonname: %s\n",var->v_commonname); + fprintf(stderr, " var->v_commoninfile: %s\n",var->v_commoninfile); + fprintf(stderr, " var->v_nbdim: %d\n",var->v_nbdim); + fprintf(stderr, " var->v_common: %d\n",var->v_common); + fprintf(stderr, " var->v_module: %d\n",var->v_module); + fprintf(stderr, " var->v_initialvalue: %s\n",var->v_initialvalue); +} diff --git a/CROCO/croco-v1.3.1/AGRIF/LIB/UtilListe.c b/CROCO/croco-v1.3.1/AGRIF/LIB/UtilListe.c new file mode 100644 index 00000000..3d392027 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/LIB/UtilListe.c @@ -0,0 +1,823 @@ +/******************************************************************************/ +/* */ +/* CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran) */ +/* */ +/* Copyright or or Copr. Laurent Debreu (Laurent.Debreu@imag.fr) */ +/* Cyril Mazauric (Cyril_Mazauric@yahoo.fr) */ +/* This software is governed by the CeCILL-C license under French law and */ +/* abiding by the rules of distribution of free software. You can use, */ +/* modify and/ or redistribute the software under the terms of the CeCILL-C */ +/* license as circulated by CEA, CNRS and INRIA at the following URL */ +/* "http://www.cecill.info". */ +/* */ +/* As a counterpart to the access to the source code and rights to copy, */ +/* modify and redistribute granted by the license, users are provided only */ +/* with a limited warranty and the software's author, the holder of the */ +/* economic rights, and the successive licensors have only limited */ +/* liability. */ +/* */ +/* In this respect, the user's attention is drawn to the risks associated */ +/* with loading, using, modifying and/or developing or reproducing the */ +/* software by the user in light of its specific status of free software, */ +/* that may mean that it is complicated to manipulate, and that also */ +/* therefore means that it is reserved for developers and experienced */ +/* professionals having in-depth computer knowledge. Users are therefore */ +/* encouraged to load and test the software's suitability as regards their */ +/* requirements in conditions enabling the security of their systems and/or */ +/* data to be ensured and, more generally, to use and operate it in the */ +/* same conditions as regards security. */ +/* */ +/* The fact that you are presently reading this means that you have had */ +/* knowledge of the CeCILL-C license and that you accept its terms. */ +/******************************************************************************/ +/* version 1.7 */ +/******************************************************************************/ +#include +#include +#include +#include "decl.h" + + +void Init_Variable(variable *var) +{ + strcpy(var->v_typevar , ""); + strcpy(var->v_nomvar , ""); + strcpy(var->v_oldname , ""); + strcpy(var->v_dimchar , ""); + strcpy(var->v_modulename , ""); + strcpy(var->v_commonname , ""); + strcpy(var->v_vallengspec , ""); + strcpy(var->v_nameinttypename , ""); + strcpy(var->v_commoninfile , ""); + strcpy(var->v_subroutinename , ""); + strcpy(var->v_precision , ""); + var->v_initialvalue = (listname *)NULL; + var->v_initialvalue_array = (listname *)NULL; + var->v_do_loop = NULL; + strcpy(var->v_IntentSpec , ""); + strcpy(var->v_readedlistdimension, ""); + var->v_nbdim = 0 ; + var->v_common = 0 ; + var->v_positioninblock = 0 ; + var->v_module = 0 ; + var->v_save = 0 ; + var->v_catvar = 0 ; + var->v_VariableIsParameter = 0 ; + var->v_PublicDeclare = 0 ; + var->v_PrivateDeclare = 0 ; + var->v_ExternalDeclare = 0 ; + var->v_pointedvar = 0 ; + var->v_notgrid = 0 ; + var->v_dimensiongiven = 0 ; + var->v_c_star = 0 ; + var->v_indicetabvars = 0 ; + var->v_pointerdeclare = 0 ; + var->v_optionaldeclare = 0 ; + var->v_allocatable = 0 ; + var->v_target = 0 ; + var->v_dimsempty = 0 ; + var->v_dimension = (listdim *) NULL; +} +/******************************************************************************/ +/* AddListvartolistvar */ +/******************************************************************************/ +/* This subroutine is used to add a listvar l at the end of a listvar */ +/* glob. */ +/* */ +/******************************************************************************/ +/* _______ _______ _______ _______ _______ */ +/* + + + + + + + + + + */ +/* + glob +--->+ glob +--->+ glob +--->+ glob +--->+ l + */ +/* +______+ +______+ +______+ +______+ +______+ */ +/* */ +/******************************************************************************/ +listvar * AddListvarToListvar ( listvar *l, listvar *glob, int ValueFirstpass ) +{ + listvar *newvar; + if ( firstpass == ValueFirstpass ) + { + if ( !glob ) glob = l; + else + { + newvar = glob; + while (newvar->suiv) + newvar = newvar->suiv; + newvar->suiv = l; + } + newvar=glob; + while (newvar) + { + newvar=newvar->suiv; + } + } + return glob; +} + +/******************************************************************************/ +/* CreateAndFillin_Curvar */ +/******************************************************************************/ +/* This subroutine is used to create the record corresponding to the */ +/* list of declaration */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +void CreateAndFillin_Curvar(const char *type, variable *curvar) +{ +listname *newvar; + + if ( !strcasecmp(type, "character") && strcasecmp(CharacterSize, "") ) + { + strcpy(curvar->v_dimchar, CharacterSize); + } + + /* On donne la precision de la variable si elle a ete donnee */ + curvar->v_c_star = 0; + if ( c_star == 1 ) curvar->v_c_star = 1; + + strcpy(curvar->v_vallengspec,""); + if ( strcasecmp(vallengspec,"") ) + { + strcpy(curvar->v_vallengspec,vallengspec); + Save_Length(vallengspec,8); + } + + strcpy(curvar->v_precision,""); + if ( strcasecmp(NamePrecision,"") ) + { + strcpy(curvar->v_precision,NamePrecision); + addprecision_derivedfromkind(curvar); + Save_Length(NamePrecision,12); + } + /* Si cette variable a ete declaree dans un module on met curvar->module=1 */ + if ( inmoduledeclare == 1 || SaveDeclare == 1 ) + { + curvar->v_module = 1; + } + /* Puis on donne le nom du module dans curvar->v_modulename */ + strcpy(curvar->v_modulename,curmodulename); + /* Si cette variable a ete initialisee */ + if (InitialValueGiven == 1 ) + { + curvar->v_initialvalue=Insertname(curvar->v_initialvalue,InitValue,0); + +// strcpy(curvar->v_initialvalue,InitValue); + + Save_Length(InitValue,14); + } + /* Si cette variable est declaree en save */ + if (SaveDeclare == 1 && !strcasecmp(curvar->v_typevar,"type")) curvar->v_save = 1; + + /* Si cette variable est v_allocatable */ + if (Allocatabledeclare == 1 ) curvar->v_allocatable=1; + + /* Si cette variable est v_target */ + if (Targetdeclare == 1 ) curvar->v_target=1; + + /* if INTENT spec has been given */ + if ( strcasecmp(IntentSpec,"") ) + { + strcpy(curvar->v_IntentSpec,IntentSpec); + Save_Length(IntentSpec,13); + } +} + + +void addprecision_derivedfromkind(variable *curvar) +{ + listnom *parcours; + char kind[LONG_VNAME]; + char kind_val[LONG_C]; + + sscanf(curvar->v_precision, "%100s =", kind_val); + + if ( !strcasecmp(kind_val, "kind") ) + sscanf(curvar->v_precision, "%50s = %50s", kind, kind_val); + + parcours = listofkind; + while (parcours) + { + if ( !strcasecmp(parcours->o_nom, kind_val) ) + { + sprintf(curvar->v_nameinttypename, "%d", parcours->o_val); + } + parcours=parcours->suiv; + } +} + +/******************************************************************************/ +/* duplicatelistvar */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +// void duplicatelistvar(listvar *orig) +// { +// listvar *parcours; +// listvar *tmplistvar; +// listvar *tmplistvarprec; +// listdim *tmplistdim; +// variable *tmpvar; +// +// tmplistvarprec = (listvar *)NULL; +// parcours = orig; +// while ( parcours ) +// { +// tmplistvar = (listvar *)calloc(1,sizeof(listvar)); +// tmpvar = (variable *)calloc(1,sizeof(variable)); +// /* */ +// Init_Variable(tmpvar); +// /* */ +// strcpy(tmpvar->v_typevar, parcours->var->v_typevar); +// strcpy(tmpvar->v_nomvar, parcours->var->v_nomvar); +// strcpy(tmpvar->v_oldname, parcours->var->v_oldname); +// strcpy(tmpvar->v_dimchar, parcours->var->v_dimchar); +// if ( parcours->var->v_dimension ) +// { +// tmplistdim = (listdim*) calloc(1,sizeof(listdim)); +// tmplistdim = parcours->var->v_dimension; +// tmpvar->v_dimension = tmplistdim; +// } +// tmpvar->v_nbdim = parcours->var->v_nbdim; +// tmpvar->v_common = parcours->var->v_common; +// tmpvar->v_module = parcours->var->v_module; +// tmpvar->v_save = parcours->var->v_save; +// tmpvar->v_positioninblock = parcours->var->v_positioninblock; +// tmpvar->v_VariableIsParameter = parcours->var->v_VariableIsParameter; +// tmpvar->v_indicetabvars = parcours->var->v_indicetabvars; +// tmpvar->v_pointedvar = parcours->var->v_pointedvar; +// tmpvar->v_dimensiongiven = parcours->var->v_dimensiongiven; +// tmpvar->v_c_star = parcours->var->v_c_star; +// tmpvar->v_catvar = parcours->var->v_catvar; +// tmpvar->v_pointerdeclare = parcours->var->v_pointerdeclare; +// tmpvar->v_optionaldeclare = parcours->var->v_optionaldeclare; +// tmpvar->v_allocatable = parcours->var->v_allocatable; +// tmpvar->v_target = parcours->var->v_target; +// tmpvar->v_dimsempty = parcours->var->v_dimsempty; +// strcpy(tmpvar->v_modulename, parcours->var->v_modulename); +// strcpy(tmpvar->v_commonname, parcours->var->v_commonname); +// strcpy(tmpvar->v_vallengspec, parcours->var->v_vallengspec); +// strcpy(tmpvar->v_nameinttypename, parcours->var->v_nameinttypename); +// strcpy(tmpvar->v_commoninfile, cur_filename); +// strcpy(tmpvar->v_subroutinename, parcours->var->v_subroutinename); +// strcpy(tmpvar->v_precision, parcours->var->v_precision); +// strcpy(tmpvar->v_initialvalue, parcours->var->v_initialvalue); +// strcpy(tmpvar->v_IntentSpec, parcours->var->v_IntentSpec); +// strcpy(tmpvar->v_readedlistdimension, parcours->var->v_readedlistdimension); +// +// tmplistvar->var = tmpvar; +// tmplistvar->suiv = NULL; +// +// if ( !listduplicated ) +// { +// listduplicated = tmplistvar; +// tmplistvarprec = listduplicated; +// } +// else +// { +// tmplistvarprec->suiv = tmplistvar; +// tmplistvarprec = tmplistvar; +// } +// parcours = parcours->suiv; +// } +// } + +/******************************************************************************/ +/* insertdim */ +/******************************************************************************/ +/* This subroutine is used to insert a record in a list of */ +/* struct : listdim */ +/******************************************************************************/ +/* _______ _______ _______ _______ _______ */ +/* + + + + + + + + + + */ +/* + NEW +--->+ lin +--->+ lin +--->+ lin +--->+ lin + */ +/* +______+ +______+ +______+ +______+ +______+ */ +/* */ +/******************************************************************************/ +listdim * insertdim(listdim *lin,typedim nom) +{ + listdim *newdim ; + listdim *parcours ; + + newdim=(listdim *) calloc(1,sizeof(listdim)); + newdim->dim=nom; + newdim->suiv=NULL; + + if ( ! lin ) + { + lin = newdim; + } + else + { + parcours = lin; + while ( parcours->suiv ) parcours=parcours->suiv; + parcours->suiv = newdim; + } + + return lin; +} + +/******************************************************************************/ +/* change_dim_char */ +/******************************************************************************/ +/* This subroutine is used to change the dimension in the list lin */ +/******************************************************************************/ +/* _______ _______ _______ _______ */ +/* + l + + l + + l + + l + */ +/* + old +--->+ old +--------------->+ lin +--->+ lin + */ +/* +______+ +______+ +______+ +______+ */ +/* */ +/******************************************************************************/ +void change_dim_char(listdim *lin,listvar * l) +{ + listvar *parcours_var; + variable *v; + + parcours_var=l; + while(parcours_var) + { + v = parcours_var->var; + strcpy(v->v_dimchar,(lin->dim).last); + parcours_var=parcours_var->suiv; + } +} + + +/******************************************************************************/ +/* get_num_dims */ +/******************************************************************************/ +/* This subroutine is used to know the dimension of a table */ +/******************************************************************************/ +/* */ +/* Dimension(jpi,jpj,jpk) ----------> get_num_dims = 3 */ +/* */ +/******************************************************************************/ +int get_num_dims ( const listdim *d ) +{ + listdim *parcours; + int compteur = 0; + + parcours = (listdim *) d; + while(parcours) + { + compteur++; + parcours = parcours->suiv; + } + return compteur; +} + + +/******************************************************************************/ +/* CREATEVAR */ +/******************************************************************************/ +/* This subroutine is used to create and initialized a record of the */ +/* struct : variable */ +/******************************************************************************/ +variable * createvar(const char *nom, listdim *d) +{ + variable *var; + listdim *dims; + char ligne[LONG_M]; + char listdimension[LONG_M]; + + var = (variable *) calloc(1,sizeof(variable)); + + Init_Variable(var); + + strcpy(listdimension,""); + strcpy(var->v_nomvar,nom); + strcpy(var->v_modulename,curmodulename); + strcpy(var->v_commoninfile,cur_filename); + strcpy(var->v_subroutinename,subroutinename); + + if ( strcasecmp(nameinttypename,"") ) + { + strcpy(var->v_nameinttypename,nameinttypename); + } + + if ( optionaldeclare == 1 ) var->v_optionaldeclare = 1; + if ( pointerdeclare == 1 ) var->v_pointerdeclare = 1; + if ( VariableIsParameter == 1 ) var->v_VariableIsParameter = 1 ; + if ( PublicDeclare == 1 ) var->v_PublicDeclare = 1 ; + if ( PrivateDeclare == 1 ) var->v_PrivateDeclare = 1; + if ( ExternalDeclare == 1 ) var->v_ExternalDeclare = 1; + + var->v_dimension = d; + + /* Creation of the string for the dimension of this variable */ + dimsempty = 1; + if ( d ) + { + var->v_dimensiongiven = 1; + dims = d; + while (dims) + { + if ( strcasecmp(dims->dim.first,"") || strcasecmp(dims->dim.last,"")) + { + dimsempty = 0; + } + sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last); + strcat(listdimension,ligne); + if ( dims->suiv ) + { + strcat(listdimension,","); + } + dims = dims->suiv; + } + if ( dimsempty == 1 || GlobalDeclarationType == 1 ) var->v_dimsempty = 1; + } + strcpy(var->v_readedlistdimension,listdimension); + Save_Length(listdimension,15); + var->v_nbdim = get_num_dims(d); + + return var; +} + +/******************************************************************************/ +/* INSERTVAR */ +/******************************************************************************/ +/* This subroutine is used to insert a record in a list of the */ +/* struct : listvar */ +/******************************************************************************/ +/* _______ _______ _______ _______ _______ */ +/* + + + + + + + + + + */ +/* + lin +--->+ lin +--->+ lin +--->+ lin +--->+ NEW + */ +/* +______+ +______+ +______+ +______+ +______+ */ +/* */ +/* */ +/******************************************************************************/ +listvar * insertvar(listvar *lin,variable *v) +{ + listvar *newvar ; + listvar *tmpvar ; + + newvar=(listvar *) calloc(1,sizeof(listvar)); + newvar->var=v; + newvar->suiv = NULL; + if (!lin) + { + newvar->suiv=NULL; + lin = newvar; + } + else + { + tmpvar = lin ; + while (tmpvar->suiv) + { + tmpvar = tmpvar ->suiv ; + } + tmpvar -> suiv = newvar; + } + return lin; +} + +/******************************************************************************/ +/* SETTYPE */ +/******************************************************************************/ +/* This subroutine is used to give the same variable type at each */ +/* record of the list of the struct : listvar */ +/******************************************************************************/ +/* _______ _______ _______ _______ _______ */ +/* + REAL + + REAL + + REAL + + REAL + + REAL + */ +/* + lin +--->+ lin +--->+ lin +--->+ lin +--->+ lin + */ +/* +______+ +______+ +______+ +______+ +______+ */ +/* */ +/* */ +/******************************************************************************/ +listvar *settype(const char *nom, listvar *lin) +{ + listvar *newvar; + variable *v; + + newvar = lin; + while (newvar) + { + v = newvar->var; + strcpy(v->v_typevar,nom); + + v->v_catvar = get_cat_var(v); + + newvar = newvar->suiv; + } + newvar = lin; + return newvar ; +} + +/******************************************************************/ +/* printliste */ +/* print the list given in argulent */ +/******************************************************************/ + +void printliste(listvar * lin) +{ + listvar *newvar; + variable *v; + + newvar=lin; + while (newvar) + { + v=newvar->var; + newvar=newvar->suiv; + } +} + +/******************************************************************************/ +/* IsinListe : return 1 if name nom is in list lin */ +/* */ +/******************************************************************************/ + int IsinListe(listvar *lin,char *nom) +{ + listvar *newvar; + variable *v; + int out ; + + newvar=lin; + out = 0; + while (newvar && (out == 0)) + { + v=newvar->var; + if (!strcasecmp(v->v_nomvar,nom) && !strcasecmp(v->v_subroutinename,subroutinename)) { + out = 1; + } + newvar=newvar->suiv; + } + + return out ; +} + +listname *Insertname(listname *lin,char *nom, int sens) +{ + listname *newvar ; + listname *tmpvar; + + newvar=(listname *) calloc(1,sizeof(listname)); + strcpy(newvar->n_name,nom); + newvar->suiv = NULL; + if (!lin) + { + newvar->suiv=NULL; + lin = newvar; + } + else + { + if (sens == 0) + { + tmpvar = lin ; + while (tmpvar->suiv) + { + tmpvar = tmpvar ->suiv ; + } + tmpvar -> suiv = newvar; + } + else + { + newvar->suiv = lin; + lin = newvar; + } + } + return lin; +} + +int testandextractfromlist(listname **lin, char*nom) +{ +listname *newvar; +int val_1, val_2; +int return_stmt; + +printname(*lin); +if (!(*lin)) + { + return 0; + } +else + { + sscanf(nom,"%d",&val_1); + sscanf((*lin)->n_name,"%d",&val_2); + if (val_1==val_2) + { +/* newvar = *lin; + *lin = (*lin)->suiv; + free(newvar);*/ + /* continue to remove while the label stays the same */ +/* return_stmt=testandextractfromlist(lin,nom);*/ + return 1; + } + else + { + return 0; + } + } +} + +void removefromlist(listname **lin, char*nom) +{ +listname *newvar,*prev; +int val_1, val_2; +int return_stmt; +int out; + +printname(*lin); +if (*lin) + { + sscanf(nom,"%d",&val_1); + prev=(listname *) calloc(1,sizeof(listname)); + prev->suiv=*lin; + *lin=prev; + newvar=(*lin)->suiv; + out = 0; + while (newvar && out == 0) + { + sscanf((newvar)->n_name,"%d",&val_2); + if (val_1==val_2) + { + prev->suiv=newvar->suiv; + free(newvar); + } + if (prev->suiv) + { + prev=prev->suiv; + newvar=prev->suiv; + } + else + { + out = 1; + } + } + prev=*lin; + *lin=(*lin)->suiv; + free(prev); + } +} + +listname *concat_listname(listname *l1, listname *l2) +{ + listname *tmpvar; + + tmpvar = l1; + while (tmpvar->suiv) + { + tmpvar = tmpvar->suiv; + } + + tmpvar->suiv = l2; + + return l1; +} + +void createstringfromlistname(char *ligne, listname *lin) +{ + listname *tmpvar; + + strcpy(ligne,""); + tmpvar = lin; + + while(tmpvar) + { + strcat(ligne,tmpvar->n_name); + if (tmpvar->suiv) strcat(ligne,","); + tmpvar=tmpvar->suiv; + } +} + +/******************************************************************/ +/* printname */ +/* print the list given in argulent */ +/******************************************************************/ + +void printname(listname * lin) +{ + listname *newvar; + + newvar=lin; + while (newvar) + { + newvar=newvar->suiv; + } +} + +void removeglobfromlist(listname **lin) +{ + listname *parcours1; + listvar *parcours2; + listname * parcourspres; + int out; + + parcours1 = *lin; + parcourspres = (listname *)NULL; + + while (parcours1) + { + parcours2 = List_Global_Var; + out = 0; + while (parcours2 && out == 0) + { + if (!strcasecmp(parcours2->var->v_nomvar,parcours1->n_name)) + { + out = 1; + } + parcours2 = parcours2->suiv; + } + if (out == 1) + { + if (parcours1 == *lin) + { + *lin = (*lin)->suiv; + parcours1 = *lin; + } + else + { + parcourspres->suiv = parcours1->suiv; + parcours1 = parcourspres->suiv; + } + } + else + { + parcourspres = parcours1; + parcours1 = parcours1->suiv; + } + } +} + +void writelistpublic(listname *lin) +{ + listname *parcours1; + char ligne[LONG_M]; + + if (lin) + { + sprintf(ligne,"public :: "); + parcours1 = lin; + + while ( parcours1 ) + { + strcat(ligne, parcours1->n_name); + if ( parcours1->suiv ) strcat(ligne,", "); + parcours1 = parcours1->suiv; + } + tofich(fortran_out,ligne,1); + } +} + +void Init_List_Data_Var() +{ + listvar *parcours; + + parcours = List_Data_Var_Cur; + + if (List_Data_Var_Cur) + { + while (parcours) + { + List_Data_Var_Cur = List_Data_Var_Cur->suiv; + free(parcours); + parcours = List_Data_Var_Cur; + } + } + List_Data_Var_Cur = NULL; +} + +int get_cat_var(variable *var) +{ + + if (!strcasecmp(var->v_typevar, "CHARACTER")) + return 1; + else if ((var->v_nbdim == 0 ) && (!strcasecmp(var->v_typevar, "REAL"))) + return 2; + else if (!strcasecmp(var->v_typevar, "LOGICAL")) + return 3; + else if (!strcasecmp(var->v_typevar, "INTEGER")) + return 4; + else + return 0; +} + +void Insertdoloop(variable *var,char *do_var,char *do_begin, char *do_end, char *do_step) +{ +listdoloop *new_do_loop; +listdoloop *tmploop; +new_do_loop = (listdoloop *) calloc(1,sizeof(listdoloop)); + +new_do_loop->cur_do_loop = (do_loop *) calloc(1,sizeof(do_loop)); + +strcpy(new_do_loop->cur_do_loop->do_variable,do_var); +strcpy(new_do_loop->cur_do_loop->do_begin,do_begin); +strcpy(new_do_loop->cur_do_loop->do_end,do_end); +strcpy(new_do_loop->cur_do_loop->do_step,do_step); +new_do_loop->suiv = NULL; + +if (!var->v_do_loop) +{ + var->v_do_loop = new_do_loop; +} +else +{ + new_do_loop->suiv = var->v_do_loop; + var->v_do_loop = new_do_loop; + +// tmploop = var->v_do_loop; +// while (tmploop->suiv) +// { +// tmploop=tmploop->suiv; +// } +// tmploop->suiv = new_do_loop ; +// } +} +} \ No newline at end of file diff --git a/CROCO/croco-v1.3.1/AGRIF/LIB/UtilNotGridDep.c b/CROCO/croco-v1.3.1/AGRIF/LIB/UtilNotGridDep.c new file mode 100644 index 00000000..b836dd87 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/LIB/UtilNotGridDep.c @@ -0,0 +1,107 @@ +/******************************************************************************/ +/* */ +/* CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran) */ +/* */ +/* Copyright or or Copr. Laurent Debreu (Laurent.Debreu@imag.fr) */ +/* Cyril Mazauric (Cyril_Mazauric@yahoo.fr) */ +/* This software is governed by the CeCILL-C license under French law and */ +/* abiding by the rules of distribution of free software. You can use, */ +/* modify and/ or redistribute the software under the terms of the CeCILL-C */ +/* license as circulated by CEA, CNRS and INRIA at the following URL */ +/* "http://www.cecill.info". */ +/* */ +/* As a counterpart to the access to the source code and rights to copy, */ +/* modify and redistribute granted by the license, users are provided only */ +/* with a limited warranty and the software's author, the holder of the */ +/* economic rights, and the successive licensors have only limited */ +/* liability. */ +/* */ +/* In this respect, the user's attention is drawn to the risks associated */ +/* with loading, using, modifying and/or developing or reproducing the */ +/* software by the user in light of its specific status of free software, */ +/* that may mean that it is complicated to manipulate, and that also */ +/* therefore means that it is reserved for developers and experienced */ +/* professionals having in-depth computer knowledge. Users are therefore */ +/* encouraged to load and test the software's suitability as regards their */ +/* requirements in conditions enabling the security of their systems and/or */ +/* data to be ensured and, more generally, to use and operate it in the */ +/* same conditions as regards security. */ +/* */ +/* The fact that you are presently reading this means that you have had */ +/* knowledge of the CeCILL-C license and that you accept its terms. */ +/******************************************************************************/ +/* version 1.7 */ +/******************************************************************************/ +#include +#include +#include +#include "decl.h" + +/******************************************************************************/ +/* Add_NotGridDepend_Var_1 */ +/******************************************************************************/ +/* This subroutine is used to add a record into List_NotGridDepend_Var */ +/* This variable is add only if it is not present in the list */ +/* This variable is add at the end of the list */ +/******************************************************************************/ +/* _______ _______ _______ _______ _______ */ +/* + not + + not + + not + + not + + + */ +/* + grid +--->+ grid +--->+ grid +--->+ grid +--->+ NEW + */ +/* +______+ +______+ +______+ +______+ +______+ */ +/* */ +/******************************************************************************/ +void Add_NotGridDepend_Var_1 (char *name) +{ + listvar *parcours; + listvar *newvar; + /* */ + /* look in the List_NotGridDepend_Var if this variable exist */ + parcours = List_NotGridDepend_Var; + while (parcours) + { + if (!strcasecmp(parcours->var->v_nomvar,name)) + { + /* if this variable exist -> exit of the program */ + printf(" The variable %s\n",name); + printf(" has been declared twice \n"); + printf(" as a non grid dependent variable \n"); + exit(1); + } + parcours= parcours->suiv; + } + /* if variable does not exist, we add it */ + newvar=(listvar *)calloc(1,sizeof(listvar)); + newvar->var=(variable *)calloc(1,sizeof(variable)); + strcpy(newvar->var->v_nomvar,name); + strcpy(newvar->var->v_commoninfile,cur_filename); + strcpy(newvar->var->v_subroutinename,subroutinename); + newvar->var->v_notgrid = 1 ; + newvar->suiv = List_NotGridDepend_Var; + List_NotGridDepend_Var = newvar; +} + +/******************************************************************************/ +/* VarIsNonGridDepend */ +/******************************************************************************/ +/* This subroutine is used to know if a variable has been declared as non */ +/* grid dependent */ +/******************************************************************************/ +/* */ +/* notgriddepend variable; -----------> VarIsNonGridDepend = 1 */ +/* */ +/* */ +/******************************************************************************/ +int VarIsNonGridDepend(char *name) +{ + listvar *newvar; + int out; + + newvar = List_NotGridDepend_Var; + out=0; + while (newvar && out == 0 ) + { + if ( !strcasecmp(newvar->var->v_nomvar,name) ) out = 1; + else newvar = newvar->suiv; + } + return out; +} diff --git a/CROCO/croco-v1.3.1/AGRIF/LIB/WorkWithAllocatelist.c b/CROCO/croco-v1.3.1/AGRIF/LIB/WorkWithAllocatelist.c new file mode 100644 index 00000000..3830e3f7 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/LIB/WorkWithAllocatelist.c @@ -0,0 +1,122 @@ +/******************************************************************************/ +/* */ +/* CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran) */ +/* */ +/* Copyright or or Copr. Laurent Debreu (Laurent.Debreu@imag.fr) */ +/* Cyril Mazauric (Cyril_Mazauric@yahoo.fr) */ +/* This software is governed by the CeCILL-C license under French law and */ +/* abiding by the rules of distribution of free software. You can use, */ +/* modify and/ or redistribute the software under the terms of the CeCILL-C */ +/* license as circulated by CEA, CNRS and INRIA at the following URL */ +/* "http://www.cecill.info". */ +/* */ +/* As a counterpart to the access to the source code and rights to copy, */ +/* modify and redistribute granted by the license, users are provided only */ +/* with a limited warranty and the software's author, the holder of the */ +/* economic rights, and the successive licensors have only limited */ +/* liability. */ +/* */ +/* In this respect, the user's attention is drawn to the risks associated */ +/* with loading, using, modifying and/or developing or reproducing the */ +/* software by the user in light of its specific status of free software, */ +/* that may mean that it is complicated to manipulate, and that also */ +/* therefore means that it is reserved for developers and experienced */ +/* professionals having in-depth computer knowledge. Users are therefore */ +/* encouraged to load and test the software's suitability as regards their */ +/* requirements in conditions enabling the security of their systems and/or */ +/* data to be ensured and, more generally, to use and operate it in the */ +/* same conditions as regards security. */ +/* */ +/* The fact that you are presently reading this means that you have had */ +/* knowledge of the CeCILL-C license and that you accept its terms. */ +/******************************************************************************/ +/* version 1.7 */ +/******************************************************************************/ +#include +#include +#include +#include "decl.h" + +/******************************************************************************/ +/* Add_Allocate_Var_1 */ +/******************************************************************************/ +/* Firstpass 1 */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +void Add_Allocate_Var_1(const char *nom, const char *nommodule) +{ + listallocate *newvar; + listallocate *parcours; + int out; + + if ( firstpass == 1 ) + { + if ( !List_Allocate_Var ) + { + newvar = (listallocate *)calloc(1,sizeof(listallocate)); + strcpy(newvar->a_nomvar,nom); + strcpy(newvar->a_subroutine,subroutinename); + strcpy(newvar->a_module,nommodule); + Save_Length(nom,25); + newvar->suiv = NULL; + List_Allocate_Var = newvar; + } + else + { + parcours = List_Allocate_Var; + out = 0 ; + while ( parcours->suiv && out == 0 ) + { + if ( !strcasecmp(parcours->a_nomvar, nom) && + !strcasecmp(parcours->a_subroutine, subroutinename) && + !strcasecmp(parcours->a_module, nommodule) ) out = 1; + else + parcours=parcours->suiv; + } + if ( out == 0 ) + { + if ( !strcasecmp(parcours->a_nomvar,nom) && + !strcasecmp(parcours->a_subroutine,subroutinename) && + !strcasecmp(parcours->a_module,nommodule) ) out = 1; + else + { + /* add the record */ + newvar = (listallocate *)calloc(1,sizeof(listallocate)); + strcpy(newvar->a_nomvar, nom); + strcpy(newvar->a_subroutine, subroutinename); + strcpy(newvar->a_module, nommodule); + Save_Length(nom,25); + newvar->suiv = NULL; + parcours->suiv = newvar; + } + } + } + } +} + + +/******************************************************************************/ +/* IsVarAllocatable_0 */ +/******************************************************************************/ +/* Firstpass 0 */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +// int IsVarAllocatable_0(const char *ident) +// { +// listallocate *parcours; +// int out; +// +// out = 0 ; +// if ( firstpass == 0 ) +// { +// parcours = List_Allocate_Var; +// while ( parcours && out == 0 ) +// { +// if ( !strcasecmp(parcours->a_nomvar,ident) ) out = 1 ; +// else parcours=parcours->suiv; +// } +// } +// return out; +// } diff --git a/CROCO/croco-v1.3.1/AGRIF/LIB/WorkWithParameterlist.c b/CROCO/croco-v1.3.1/AGRIF/LIB/WorkWithParameterlist.c new file mode 100644 index 00000000..4753bee0 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/LIB/WorkWithParameterlist.c @@ -0,0 +1,101 @@ +/******************************************************************************/ +/* */ +/* CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran) */ +/* */ +/* Copyright or or Copr. Laurent Debreu (Laurent.Debreu@imag.fr) */ +/* Cyril Mazauric (Cyril_Mazauric@yahoo.fr) */ +/* This software is governed by the CeCILL-C license under French law and */ +/* abiding by the rules of distribution of free software. You can use, */ +/* modify and/ or redistribute the software under the terms of the CeCILL-C */ +/* license as circulated by CEA, CNRS and INRIA at the following URL */ +/* "http://www.cecill.info". */ +/* */ +/* As a counterpart to the access to the source code and rights to copy, */ +/* modify and redistribute granted by the license, users are provided only */ +/* with a limited warranty and the software's author, the holder of the */ +/* economic rights, and the successive licensors have only limited */ +/* liability. */ +/* */ +/* In this respect, the user's attention is drawn to the risks associated */ +/* with loading, using, modifying and/or developing or reproducing the */ +/* software by the user in light of its specific status of free software, */ +/* that may mean that it is complicated to manipulate, and that also */ +/* therefore means that it is reserved for developers and experienced */ +/* professionals having in-depth computer knowledge. Users are therefore */ +/* encouraged to load and test the software's suitability as regards their */ +/* requirements in conditions enabling the security of their systems and/or */ +/* data to be ensured and, more generally, to use and operate it in the */ +/* same conditions as regards security. */ +/* */ +/* The fact that you are presently reading this means that you have had */ +/* knowledge of the CeCILL-C license and that you accept its terms. */ +/******************************************************************************/ +/* version 1.7 */ +/******************************************************************************/ +#include +#include +#include +#include "decl.h" + +/******************************************************************************/ +/* Add_GlobalParameter_Var_1 */ +/******************************************************************************/ +/* This subroutines is used to add the variable defined in common in the */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +void Add_GlobalParameter_Var_1(listvar *listin) +{ + if ( VariableIsParameter ) + List_GlobalParameter_Var = AddListvarToListvar(listin, List_GlobalParameter_Var, 1); +} + +/******************************************************************************/ +/* Add_Parameter_Var_1 */ +/******************************************************************************/ +/* This subroutines is used to add the variable defined in common in the */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +void Add_Parameter_Var_1(listvar *listin) +{ + listvar *parcours; + + if ( !VariableIsParameter ) return; + + if ( List_Parameter_Var == NULL ) + { + List_Parameter_Var = listin; + } + else + { + parcours = List_Parameter_Var; + while ( parcours->suiv ) + parcours = parcours->suiv; + parcours->suiv = listin; + } +} + +/******************************************************************************/ +/* Add_Dimension_Var_1 */ +/******************************************************************************/ +/* This subroutines is used to add the variable defined in common in the */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +void Add_Dimension_Var_1(listvar *listin) +{ + listvar *parcours; + + if ( List_Dimension_Var == NULL ) + { + List_Dimension_Var = listin; + } + else + { + parcours = List_Dimension_Var; + while (parcours->suiv) + parcours = parcours->suiv; + parcours->suiv = listin; + } +} diff --git a/CROCO/croco-v1.3.1/AGRIF/LIB/WorkWithglobliste.c b/CROCO/croco-v1.3.1/AGRIF/LIB/WorkWithglobliste.c new file mode 100644 index 00000000..2337879c --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/LIB/WorkWithglobliste.c @@ -0,0 +1,107 @@ +/******************************************************************************/ +/* */ +/* CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran) */ +/* */ +/* Copyright or or Copr. Laurent Debreu (Laurent.Debreu@imag.fr) */ +/* Cyril Mazauric (Cyril_Mazauric@yahoo.fr) */ +/* This software is governed by the CeCILL-C license under French law and */ +/* abiding by the rules of distribution of free software. You can use, */ +/* modify and/ or redistribute the software under the terms of the CeCILL-C */ +/* license as circulated by CEA, CNRS and INRIA at the following URL */ +/* "http://www.cecill.info". */ +/* */ +/* As a counterpart to the access to the source code and rights to copy, */ +/* modify and redistribute granted by the license, users are provided only */ +/* with a limited warranty and the software's author, the holder of the */ +/* economic rights, and the successive licensors have only limited */ +/* liability. */ +/* */ +/* In this respect, the user's attention is drawn to the risks associated */ +/* with loading, using, modifying and/or developing or reproducing the */ +/* software by the user in light of its specific status of free software, */ +/* that may mean that it is complicated to manipulate, and that also */ +/* therefore means that it is reserved for developers and experienced */ +/* professionals having in-depth computer knowledge. Users are therefore */ +/* encouraged to load and test the software's suitability as regards their */ +/* requirements in conditions enabling the security of their systems and/or */ +/* data to be ensured and, more generally, to use and operate it in the */ +/* same conditions as regards security. */ +/* */ +/* The fact that you are presently reading this means that you have had */ +/* knowledge of the CeCILL-C license and that you accept its terms. */ +/******************************************************************************/ +/* version 1.7 */ +/******************************************************************************/ +#include +#include +#include +#include "decl.h" + +/******************************************************************************/ +/* Add_Globliste_1 */ +/******************************************************************************/ +/* Firstpass 1 */ +/* We should add this declaration to the List_Global_Var */ +/******************************************************************************/ +void Add_Globliste_1(listvar *listtoadd) +{ + if ( aftercontainsdeclare == 0 && VariableIsParameter == 0 ) + { + List_Global_Var = AddListvarToListvar(listtoadd, List_Global_Var, 1); + } +} + +/******************************************************************************/ +/* Add_SubroutineDeclarationSave_Var_1 */ +/******************************************************************************/ +/* Firstpass 1 */ +/* We should add this declaration to the List_Global_Var. case SAVE */ +/******************************************************************************/ +void Add_SubroutineDeclarationSave_Var_1(listvar *listtoadd) +{ + if ( firstpass == 1 ) + { + if ( VariableIsParameter == 0 && + SaveDeclare == 1 ) + { + List_Global_Var = AddListvarToListvar(listtoadd,List_Global_Var,1); + } + } +} + +void checkandchangedims(listvar *listsecondpass) +{ +listvar *parcours; +listvar *parcours1; +variable * newvar; +variable * oldvar; + +int out ; + +printliste(List_Global_Var); +printliste(List_SubroutineDeclaration_Var); + +parcours = listsecondpass; +while (parcours) +{ +newvar = parcours->var; +parcours1 = List_SubroutineDeclaration_Var; +out = 0; +while (parcours1 && out == 0) +{ + oldvar = parcours1->var; + if (!strcasecmp(newvar->v_nomvar,oldvar->v_nomvar) && !strcasecmp(newvar->v_subroutinename,subroutinename)) + { + if (newvar->v_dimensiongiven == 1) + { + strcpy(oldvar->v_dimension->dim.last,newvar->v_dimension->dim.last); + strcpy(oldvar->v_dimension->dim.first,newvar->v_dimension->dim.first); + } + out = 1; + } + parcours1 = parcours1->suiv; +} +parcours = parcours->suiv; +} +printliste(List_SubroutineDeclaration_Var); +} diff --git a/CROCO/croco-v1.3.1/AGRIF/LIB/WorkWithlistdatavariable.c b/CROCO/croco-v1.3.1/AGRIF/LIB/WorkWithlistdatavariable.c new file mode 100644 index 00000000..05a39c58 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/LIB/WorkWithlistdatavariable.c @@ -0,0 +1,216 @@ +/******************************************************************************/ +/* */ +/* CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran) */ +/* */ +/* Copyright or or Copr. Laurent Debreu (Laurent.Debreu@imag.fr) */ +/* Cyril Mazauric (Cyril_Mazauric@yahoo.fr) */ +/* This software is governed by the CeCILL-C license under French law and */ +/* abiding by the rules of distribution of free software. You can use, */ +/* modify and/ or redistribute the software under the terms of the CeCILL-C */ +/* license as circulated by CEA, CNRS and INRIA at the following URL */ +/* "http://www.cecill.info". */ +/* */ +/* As a counterpart to the access to the source code and rights to copy, */ +/* modify and redistribute granted by the license, users are provided only */ +/* with a limited warranty and the software's author, the holder of the */ +/* economic rights, and the successive licensors have only limited */ +/* liability. */ +/* */ +/* In this respect, the user's attention is drawn to the risks associated */ +/* with loading, using, modifying and/or developing or reproducing the */ +/* software by the user in light of its specific status of free software, */ +/* that may mean that it is complicated to manipulate, and that also */ +/* therefore means that it is reserved for developers and experienced */ +/* professionals having in-depth computer knowledge. Users are therefore */ +/* encouraged to load and test the software's suitability as regards their */ +/* requirements in conditions enabling the security of their systems and/or */ +/* data to be ensured and, more generally, to use and operate it in the */ +/* same conditions as regards security. */ +/* */ +/* The fact that you are presently reading this means that you have had */ +/* knowledge of the CeCILL-C license and that you accept its terms. */ +/******************************************************************************/ +/* version 1.7 */ +/******************************************************************************/ +#include +#include +#include +#include "decl.h" +/******************************************************************************/ +/* Add_Data_Var_1 */ +/******************************************************************************/ +/* This subroutine is used to add a record to List_Data_Var */ +/******************************************************************************/ +/* _______ _______ _______ _______ _______ */ +/* + + + + + + + + + + */ +/* + NEW +--->+ data +--->+ data +--->+ data +--->+ data+ */ +/* +______+ +______+ +______+ +______+ +______+ */ +/* */ +/******************************************************************************/ +void Add_Data_Var_1 (listvar **curlist,char *name,char *values) +{ + listvar *newvar; + char ligne[LONG_M]; + +// if ( firstpass == 1 ) +// { + newvar=(listvar *)calloc(1,sizeof(listvar)); + newvar->var=(variable *)calloc(1,sizeof(variable)); + /* */ + Init_Variable(newvar->var); + /* */ + if ( inmoduledeclare == 1 ) newvar->var->v_module=1; + strcpy(newvar->var->v_nomvar,name); + strcpy(newvar->var->v_subroutinename,subroutinename); + strcpy(newvar->var->v_modulename,curmodulename); + strcpy(newvar->var->v_commoninfile,cur_filename); + if (strchr(values,',') && strncasecmp(values,"'",1)) + sprintf(ligne,"(/%s/)",values); + else + strcpy(ligne,values); + + newvar->var->v_initialvalue=Insertname(newvar->var->v_initialvalue,ligne,0); + + // strcpy(newvar->var->v_initialvalue,ligne); + Save_Length(ligne,14); + newvar->suiv = NULL; + if ( ! (*curlist) ) + { + *curlist = newvar ; + } + else + { + newvar->suiv = *curlist; + *curlist = newvar; + } +// } +} + +void Add_Data_Var_Names_01 (listvar **curlist,listvar *l1,listname *l2) +{ + listvar *newvar; + listvar *tmpvar; + listvar *tmpvar1; + listname *tmpvar2; + char tempname[LONG_M]; + variable *found_var = NULL; + int out; + size_t i = 0; + char chartmp[2]; + + tmpvar1 = l1; + tmpvar2 = l2; + + while (tmpvar1) + { +// printf("TMPVAR 1 nomvar = %s, initialvaluearra = %s\n",tmpvar1->var->v_nomvar,tmpvar1->var->v_initialvalue_array->n_name); + strcpy(tempname,tmpvar1->var->v_nomvar); +// while ( i < strlen(tmpvar1->var->v_nomvar) ) +// { +// if (tmpvar1->var->v_nomvar[i]=='(') break; +// sprintf(chartmp,"%c",tmpvar1->var->v_nomvar[i]); +// strcat(tempname,chartmp); +// i++; +// } + found_var = get_variable_in_list_from_name(List_Common_Var, tempname); + if ( ! found_var ) found_var = get_variable_in_list_from_name(List_Global_Var,tempname); + if ( ! found_var ) found_var = get_variable_in_list_from_name(List_SubroutineDeclaration_Var,tempname); + + if ( found_var && found_var->v_nbdim > 1000 ) + { + printf("##############################################################################################################\n"); + printf("## CONV Error : arrays in data_stmt_object lists not yet supported. Please complain to the proper authorities.\n"); + printf("## variable name : %s (in %s:%s:%s)\n", found_var->v_nomvar, found_var->v_modulename, + found_var->v_subroutinename, found_var->v_commonname); + exit(1); + } + + if (tmpvar1->var->v_initialvalue_array) + { + if ((firstpass == 1) && strcmp(tmpvar1->var->v_initialvalue_array->n_name,"")) + { + DecomposeTheName(tmpvar1->var->v_initialvalue_array->n_name); + } + } + + // Search for existing newvar + + tmpvar = *curlist; + out = 0; + while (tmpvar) + { + if (!strcasecmp(tempname,tmpvar->var->v_nomvar) && !strcasecmp(subroutinename,tmpvar->var->v_subroutinename) && !strcasecmp(curmodulename,tmpvar->var->v_modulename) && !strcasecmp(cur_filename,tmpvar->var->v_commoninfile) ) + { + out = 1; + break; + } + tmpvar=tmpvar->suiv; + } + if (out == 0) + { + newvar = (listvar *) calloc(1,sizeof(listvar)); + newvar->var = (variable *) calloc(1,sizeof(variable)); + + Init_Variable(newvar->var); + + if ( inmoduledeclare == 1 ) newvar->var->v_module=1; + + strcpy(newvar->var->v_nomvar,tempname); + strcpy(newvar->var->v_subroutinename,subroutinename); + strcpy(newvar->var->v_modulename,curmodulename); + strcpy(newvar->var->v_commoninfile,cur_filename); + /*printf("TMPVAR 2 nomvar = %s\n",tmpvar2->n_name);*/ + newvar->var->v_initialvalue=Insertname(newvar->var->v_initialvalue,tmpvar2->n_name,0); + + if (tmpvar1->var->v_initialvalue_array) + { + if (strcmp(tmpvar1->var->v_initialvalue_array->n_name,"")) + { + newvar->var->v_initialvalue_array=Insertname(newvar->var->v_initialvalue_array,tmpvar1->var->v_initialvalue_array->n_name,0); + } + } + newvar->var->v_do_loop=tmpvar1->var->v_do_loop; +// strcpy(newvar->var->v_initialvalue,tmpvar2->n_name); +// strcpy(newvar->var->v_initialvalue_array,tmpvar1->var->v_initialvalue_array); + + newvar->var->v_dimension=tmpvar1->var->v_dimension; + + Save_Length(tmpvar2->n_name,14); + + newvar->suiv = NULL; + + if ( *curlist != NULL ) + { + tmpvar = *curlist; + while (tmpvar->suiv) + tmpvar = tmpvar->suiv; + tmpvar->suiv = newvar; + } + else + { + *curlist = newvar ; + } + tmpvar=newvar; + } + else // out = 1 + { + tmpvar->var->v_initialvalue=Insertname(tmpvar->var->v_initialvalue,tmpvar2->n_name,0); + if (strcmp(tmpvar1->var->v_initialvalue_array->n_name,"")) + { + tmpvar->var->v_initialvalue_array=Insertname(tmpvar->var->v_initialvalue_array,tmpvar1->var->v_initialvalue_array->n_name,0); + } + tmpvar->var->v_do_loop=tmpvar1->var->v_do_loop; + } + + tmpvar1 = tmpvar1->suiv; + tmpvar2 = tmpvar2->suiv; + } + + while (tmpvar2) + { + strcpy(tempname,tmpvar2->n_name); + tmpvar->var->v_initialvalue = Insertname(tmpvar->var->v_initialvalue,tempname,1); + tmpvar2 = tmpvar2->suiv; + } + +} diff --git a/CROCO/croco-v1.3.1/AGRIF/LIB/WorkWithlistmoduleinfile.c b/CROCO/croco-v1.3.1/AGRIF/LIB/WorkWithlistmoduleinfile.c new file mode 100644 index 00000000..e32038ac --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/LIB/WorkWithlistmoduleinfile.c @@ -0,0 +1,160 @@ +/******************************************************************************/ +/* */ +/* CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran) */ +/* */ +/* Copyright or or Copr. Laurent Debreu (Laurent.Debreu@imag.fr) */ +/* Cyril Mazauric (Cyril_Mazauric@yahoo.fr) */ +/* This software is governed by the CeCILL-C license under French law and */ +/* abiding by the rules of distribution of free software. You can use, */ +/* modify and/ or redistribute the software under the terms of the CeCILL-C */ +/* license as circulated by CEA, CNRS and INRIA at the following URL */ +/* "http://www.cecill.info". */ +/* */ +/* As a counterpart to the access to the source code and rights to copy, */ +/* modify and redistribute granted by the license, users are provided only */ +/* with a limited warranty and the software's author, the holder of the */ +/* economic rights, and the successive licensors have only limited */ +/* liability. */ +/* */ +/* In this respect, the user's attention is drawn to the risks associated */ +/* with loading, using, modifying and/or developing or reproducing the */ +/* software by the user in light of its specific status of free software, */ +/* that may mean that it is complicated to manipulate, and that also */ +/* therefore means that it is reserved for developers and experienced */ +/* professionals having in-depth computer knowledge. Users are therefore */ +/* encouraged to load and test the software's suitability as regards their */ +/* requirements in conditions enabling the security of their systems and/or */ +/* data to be ensured and, more generally, to use and operate it in the */ +/* same conditions as regards security. */ +/* */ +/* The fact that you are presently reading this means that you have had */ +/* knowledge of the CeCILL-C license and that you accept its terms. */ +/******************************************************************************/ +/* version 1.7 */ +/******************************************************************************/ +#include +#include +#include +#include "decl.h" + +void Save_Length(const char *nom, int whichone) +{ + size_t len_nom = strlen(nom); + + if ( whichone == 1 && len_nom > length_last ) + { + length_last = len_nom; + if ( length_last > LONG_M ) + printf("WARNING 1 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_last+100); + } + if ( whichone == 2 && len_nom > length_first ) + { + length_first = len_nom; + if ( length_first > LONG_M ) + printf("WARNING 2 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_first+100); + } + if ( whichone == 8 && len_nom > length_v_vallengspec ) + { + length_v_vallengspec = len_nom; + if ( length_v_vallengspec > LONG_M ) + printf("WARNING 8 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_v_vallengspec+100); + } + if ( whichone == 12 && len_nom > length_v_precision ) + { + length_v_precision = len_nom; + if ( length_v_precision > LONG_M ) + printf("WARNING 12 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_v_precision+100); + } + if ( whichone == 13 && len_nom > length_v_IntentSpec ) + { + length_v_IntentSpec = len_nom; + if ( length_v_IntentSpec > LONG_M ) + printf("WARNING 13 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_v_IntentSpec+100); + } + if ( whichone == 14 && len_nom > length_v_initialvalue ) + { + length_v_initialvalue = len_nom; + if ( length_v_initialvalue > LONG_M ) + printf("WARNING 14 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_v_initialvalue+100); + } + if ( whichone == 15 && len_nom > length_v_readedlistdimension ) + { + length_v_readedlistdimension = len_nom; + if ( length_v_readedlistdimension > LONG_M ) + printf("WARNING 15 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_v_readedlistdimension+100); + } + if ( whichone == 25 && len_nom > length_a_nomvar ) + { + length_a_nomvar = len_nom; + if ( length_a_nomvar > LONG_C ) + printf("WARNING 25 : The value of LONG_C (defined in decl.h) should be upgrated to %lu\n", length_a_nomvar+100); + } + if ( whichone == 39 && len_nom > length_toprintglob ) + { + length_toprintglob = len_nom; + if ( length_toprintglob > LONG_M ) + printf("WARNING 39 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_toprintglob+100); + } + if ( whichone == 40 && len_nom > length_tmpvargridname ) + { + length_tmpvargridname = len_nom; + if ( length_tmpvargridname > LONG_M ) + printf("WARNING 40 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_tmpvargridname+100); + } + if ( whichone == 41 && len_nom > length_ligne_Subloop ) + { + length_ligne_Subloop = len_nom; + if ( length_ligne_Subloop > LONG_M ) + printf("WARNING 41 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n",length_ligne_Subloop+100); + } + if ( whichone == 43 && len_nom > length_toprint_utilagrif ) + { + length_toprint_utilagrif = len_nom; + if ( length_toprint_utilagrif > LONG_M ) + printf("WARNING 43 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_toprint_utilagrif+100); + } + if ( whichone == 44 && len_nom > length_toprinttmp_utilchar ) + { + length_toprinttmp_utilchar = len_nom; + if ( length_toprinttmp_utilchar > LONG_M) + printf("WARNING 44 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_toprinttmp_utilchar+100); + } + if ( whichone == 45 && len_nom > length_ligne_writedecl ) + { + length_ligne_writedecl = len_nom; + if ( length_ligne_writedecl > LONG_M ) + printf("WARNING 45 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_ligne_writedecl+100); + } + if ( whichone == 46 && len_nom > length_newname_toamr ) + { + length_newname_toamr = len_nom; + if ( length_newname_toamr > LONG_C ) + printf("WARNING 46 : The value of LONG_C (defined in decl.h) should be upgrated to %lu\n", length_newname_toamr+100); + } + if ( whichone == 47 && len_nom > length_newname_writedecl ) + { + length_newname_writedecl = len_nom; + if ( length_newname_writedecl > LONG_M ) + printf("WARNING 47 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_newname_writedecl +100); + } + if ( whichone == 48 && len_nom > length_ligne_toamr ) + { + length_ligne_toamr = len_nom; + if ( length_ligne_toamr > LONG_M ) + printf("WARNING 48 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_ligne_toamr +100); + } + if ( whichone == 49 && len_nom > length_tmpligne_writedecl ) + { + length_tmpligne_writedecl = len_nom; + if ( length_tmpligne_writedecl > LONG_M ) + printf("WARNING 49 : The value of LONG_M (defined in decl.h) should be upgrated to %lu\n", length_tmpligne_writedecl+100); + } +} + +void Save_Length_int(int val, int whichone) +{ + if ( whichone == 1 && val > value_char_size ) value_char_size = val; + if ( whichone == 2 && val > value_char_size1 ) value_char_size1 = val; + if ( whichone == 3 && val > value_char_size2 ) value_char_size2 = val; + if ( whichone == 4 && val > value_char_size3 ) value_char_size3 = val; +} diff --git a/CROCO/croco-v1.3.1/AGRIF/LIB/WorkWithlistofcoupled.c b/CROCO/croco-v1.3.1/AGRIF/LIB/WorkWithlistofcoupled.c new file mode 100644 index 00000000..aaf6f5e0 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/LIB/WorkWithlistofcoupled.c @@ -0,0 +1,105 @@ +/******************************************************************************/ +/* */ +/* CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran) */ +/* */ +/* Copyright or or Copr. Laurent Debreu (Laurent.Debreu@imag.fr) */ +/* Cyril Mazauric (Cyril_Mazauric@yahoo.fr) */ +/* This software is governed by the CeCILL-C license under French law and */ +/* abiding by the rules of distribution of free software. You can use, */ +/* modify and/ or redistribute the software under the terms of the CeCILL-C */ +/* license as circulated by CEA, CNRS and INRIA at the following URL */ +/* "http://www.cecill.info". */ +/* */ +/* As a counterpart to the access to the source code and rights to copy, */ +/* modify and redistribute granted by the license, users are provided only */ +/* with a limited warranty and the software's author, the holder of the */ +/* economic rights, and the successive licensors have only limited */ +/* liability. */ +/* */ +/* In this respect, the user's attention is drawn to the risks associated */ +/* with loading, using, modifying and/or developing or reproducing the */ +/* software by the user in light of its specific status of free software, */ +/* that may mean that it is complicated to manipulate, and that also */ +/* therefore means that it is reserved for developers and experienced */ +/* professionals having in-depth computer knowledge. Users are therefore */ +/* encouraged to load and test the software's suitability as regards their */ +/* requirements in conditions enabling the security of their systems and/or */ +/* data to be ensured and, more generally, to use and operate it in the */ +/* same conditions as regards security. */ +/* */ +/* The fact that you are presently reading this means that you have had */ +/* knowledge of the CeCILL-C license and that you accept its terms. */ +/******************************************************************************/ +/* version 1.7 */ +/******************************************************************************/ +#include +#include +#include + +#include "decl.h" + +/******************************************************************************/ +/* variscoupled_0 */ +/******************************************************************************/ +/* Firstpass 0 */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +int variscoupled_0(const char *ident) +{ + listvarpointtovar *pointtmplist; + listcouple *coupletmp; + int out = 0; + + if (firstpass == 0 ) + { + pointtmplist = List_CouplePointed_Var; + while ( pointtmplist && out == 0) + { + coupletmp = pointtmplist->t_couple; + while ( coupletmp && out == 0) + { + /* we should find the same variable name in the same subroutine */ + if ( !strcasecmp(ident, coupletmp->c_namevar) && + !strcasecmp(subroutinename, pointtmplist->t_cursubroutine) && + strcasecmp(coupletmp->c_namepointedvar, "") ) + { + out = 1; + } + coupletmp = coupletmp->suiv; + } + pointtmplist = pointtmplist->suiv; + } + } + return out; +} + +const char * getcoupledname_0(const char *ident) +{ + listvarpointtovar *pointtmplist; + listcouple *coupletmp; + int out = 0; + + if (firstpass == 0 ) + { + pointtmplist = List_CouplePointed_Var; + while ( pointtmplist && out == 0) + { + coupletmp = pointtmplist->t_couple; + while ( coupletmp && out == 0) + { + /* we should find the same variable name in the same subroutine */ + if ( !strcasecmp(coupletmp->c_namevar,ident) && + !strcasecmp(pointtmplist->t_cursubroutine,subroutinename) && + strcasecmp(coupletmp->c_namepointedvar,"") ) + { + return coupletmp->c_namepointedvar; + } + coupletmp = coupletmp->suiv; + } + pointtmplist = pointtmplist->suiv; + } + } + printf("end of getcoupledname_0 -- you should not be there !!! \n"); + return NULL; +} diff --git a/CROCO/croco-v1.3.1/AGRIF/LIB/WorkWithlistofmodulebysubroutine.c b/CROCO/croco-v1.3.1/AGRIF/LIB/WorkWithlistofmodulebysubroutine.c new file mode 100644 index 00000000..89b17d1b --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/LIB/WorkWithlistofmodulebysubroutine.c @@ -0,0 +1,303 @@ +/******************************************************************************/ +/* */ +/* CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran) */ +/* */ +/* Copyright or or Copr. Laurent Debreu (Laurent.Debreu@imag.fr) */ +/* Cyril Mazauric (Cyril_Mazauric@yahoo.fr) */ +/* This software is governed by the CeCILL-C license under French law and */ +/* abiding by the rules of distribution of free software. You can use, */ +/* modify and/ or redistribute the software under the terms of the CeCILL-C */ +/* license as circulated by CEA, CNRS and INRIA at the following URL */ +/* "http://www.cecill.info". */ +/* */ +/* As a counterpart to the access to the source code and rights to copy, */ +/* modify and redistribute granted by the license, users are provided only */ +/* with a limited warranty and the software's author, the holder of the */ +/* economic rights, and the successive licensors have only limited */ +/* liability. */ +/* */ +/* In this respect, the user's attention is drawn to the risks associated */ +/* with loading, using, modifying and/or developing or reproducing the */ +/* software by the user in light of its specific status of free software, */ +/* that may mean that it is complicated to manipulate, and that also */ +/* therefore means that it is reserved for developers and experienced */ +/* professionals having in-depth computer knowledge. Users are therefore */ +/* encouraged to load and test the software's suitability as regards their */ +/* requirements in conditions enabling the security of their systems and/or */ +/* data to be ensured and, more generally, to use and operate it in the */ +/* same conditions as regards security. */ +/* */ +/* The fact that you are presently reading this means that you have had */ +/* knowledge of the CeCILL-C license and that you accept its terms. */ +/******************************************************************************/ +/* version 1.7 */ +/******************************************************************************/ +#include +#include +#include + +#include "decl.h" + + + +/******************************************************************************/ +/* RecordUseModulesVariables */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +void RecordUseModulesVariables() +{ + listusemodule *tmplistmodule; + + /* we should record all variables defined in modules used in this file */ + if ( List_NameOfModuleUsed ) + { + tmplistmodule = List_NameOfModuleUsed; + while ( tmplistmodule ) + { + if ( tmplistmodule->u_firstuse == 1 ) + { + /* check if the file .depend exist */ + List_ModuleUsed_Var = Readthedependfile + (tmplistmodule->u_usemodule,List_ModuleUsed_Var); + List_GlobParamModuleUsed_Var = ReaddependParameterList + (tmplistmodule->u_usemodule,List_GlobParamModuleUsed_Var); + + } + + tmplistmodule = tmplistmodule->suiv; + } + } +} + +/******************************************************************************/ +/* RecordUseModulesUseModulesVariables */ +/******************************************************************************/ +/******************************************************************************/ +void RecordUseModulesUseModulesVariables() +{ + listusemodule *tmplistmodule; + listusemodule *save_list; + + if ( ! List_NameOfModuleUsed ) return; + + /* we should record all variables defined in modules used in this file */ + /* and we should read the .depend of the module used by the module used */ + tmplistmodule = List_NameOfModuleUsed; + while ( tmplistmodule ) + { + Readthedependlistofmoduleused(tmplistmodule->u_usemodule); + while( tmpuselocallist ) + { + Addmoduletothelisttmp(tmpuselocallist->u_usemodule); + save_list = tmpuselocallist->suiv; + free(tmpuselocallist); + tmpuselocallist = save_list; + } + tmplistmodule = tmplistmodule->suiv; + } + tmplistmodule = listofmoduletmp; + while ( tmplistmodule ) + { + Readthedependlistofmoduleused(tmplistmodule->u_usemodule); + while( tmpuselocallist ) + { + Addmoduletothelisttmp(tmpuselocallist->u_usemodule); + save_list = tmpuselocallist->suiv; + free(tmpuselocallist); + tmpuselocallist = save_list; + } + tmplistmodule = tmplistmodule->suiv; + } + tmplistmodule = listofmoduletmp; + while ( tmplistmodule ) + { + // check if the file .depend exists + List_ModuleUsedInModuleUsed_Var = + Readthedependfile(tmplistmodule->u_usemodule,List_ModuleUsedInModuleUsed_Var); + + List_GlobParamModuleUsedInModuleUsed_Var = + ReaddependParameterList(tmplistmodule->u_usemodule,List_GlobParamModuleUsedInModuleUsed_Var); + tmplistmodule = tmplistmodule->suiv; + } +} + +/******************************************************************************/ +/* Add_NameOfModuleUsed_1 */ +/******************************************************************************/ +/* This subroutine is used to add a record to a list of struct */ +/* listusemodule */ +/******************************************************************************/ +/* */ +/* subroutine sub ... USE mod1 ===> insert in list */ +/* _______ _______ _______ _______ _______ */ +/* + + + + + + + + + + */ +/* + NEW +--->+ list +--->+ list +--->+ list +--->+ list + */ +/* +______+ +______+ +______+ +______+ +______+ */ +/* */ +/* list = List_NameOfModuleUsed */ +/* */ +/******************************************************************************/ +void Add_NameOfModuleUsed_1(char *name) +{ + listusemodule *newmodule; + listusemodule *parcours; + int out; + + newmodule = (listusemodule*) calloc(1, sizeof(listusemodule)); + strcpy(newmodule->u_usemodule, name); + strcpy(newmodule->u_charusemodule, charusemodule); + strcpy(newmodule->u_modulename, curmodulename); + strcpy(newmodule->u_cursubroutine, subroutinename); + newmodule->u_firstuse = 1 ; + newmodule->suiv = NULL; + + if ( List_NameOfModuleUsed == NULL ) + { + List_NameOfModuleUsed = newmodule ; + } + else + { + parcours = List_NameOfModuleUsed; + while ( parcours && newmodule->u_firstuse ) + { + if ( !strcasecmp(name,parcours->u_usemodule) ) + { + newmodule->u_firstuse = 0 ; + } + parcours = parcours->suiv; + } + /* we can not add the same module twice for the same subroutine */ + parcours = List_NameOfModuleUsed; + out = 0 ; + while ( parcours && out == 0 ) + { + if ( !strcasecmp(name,parcours->u_usemodule) && + !strcasecmp(subroutinename,parcours->u_cursubroutine) ) + { + out = 1 ; + free(newmodule); + } + else + parcours = parcours->suiv; + } + if ( out == 0 ) + { + newmodule->suiv = List_NameOfModuleUsed; + List_NameOfModuleUsed = newmodule; + } + } +} + +/******************************************************************************/ +/* Addmoduletothelist */ +/******************************************************************************/ +/* This subroutine is used to add a record to a list of struct */ +/* listusemodule */ +/******************************************************************************/ +/* */ +/* subroutine sub ... USE mod1 ===> insert in list */ +/* _______ _______ _______ _______ _______ */ +/* + + + + + + + + + + */ +/* + NEW +--->+ list +--->+ list +--->+ list +--->+ list + */ +/* +______+ +______+ +______+ +______+ +______+ */ +/* */ +/* list = List_NameOfModuleUsed */ +/* */ +/******************************************************************************/ +void Addmoduletothelist(const char *name) +{ + listusemodule *newmodule; + listusemodule *parcours; + int out; + + newmodule = (listusemodule*) calloc(1,sizeof(listusemodule)); + strcpy(newmodule->u_usemodule, name); + strcpy(newmodule->u_charusemodule, charusemodule); + strcpy(newmodule->u_cursubroutine, subroutinename); + newmodule->u_firstuse = 1 ; + newmodule->suiv = NULL; + + if ( !List_NameOfModuleUsed ) + { + List_NameOfModuleUsed = newmodule ; + } + else + { + parcours = List_NameOfModuleUsed; + while ( parcours && newmodule->u_firstuse == 1 ) + { + if ( !strcasecmp(name,parcours->u_usemodule) ) + { + newmodule->u_firstuse = 0 ; + } + parcours=parcours->suiv; + } + /* we can not add the same module twice for the same subroutine */ + parcours = List_NameOfModuleUsed; + out = 0 ; + while ( parcours && out == 0 ) + { + if ( !strcasecmp(name,parcours->u_usemodule) && + !strcasecmp(subroutinename,parcours->u_cursubroutine) ) + { + out = 1 ; + free(newmodule); + } + else + parcours=parcours->suiv; + } + if ( out == 0 ) + { + newmodule->suiv = List_NameOfModuleUsed; + List_NameOfModuleUsed = newmodule; + } + } +} + + +/******************************************************************************/ +/* WriteUsemoduleDeclaration */ +/******************************************************************************/ +/* Firstpass 0 */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +void WriteUsemoduleDeclaration(const char *cursubroutinename) +{ + listusemodule *newmodule; + listvarpointtovar *pointtmp; + long int fictifpos; + int findcoupled; + + fprintf(fortran_out,"\n"); + newmodule = List_NameOfModuleUsed; + + while ( newmodule ) + { + if ( !strcasecmp(newmodule->u_cursubroutine, cursubroutinename) ) + { + if (strcmp(newmodule->u_charusemodule,"")) + { +/* + findcoupled = 0; + pointtmp = List_CouplePointed_Var; + while(pointtmp) + { + if ((!strcasecmp(pointtmp->t_usemodule, newmodule->u_charusemodule)) && \ + (!strcasecmp(pointtmp->t_cursubroutine, cursubroutinename))) + { + fictifpos = setposcur(); + variableisglobalinmodule(pointtmp->t_couple,newmodule->u_charusemodule,fortran_out,fictifpos); + findcoupled = 1; + } + pointtmp=pointtmp->suiv; + } + if (findcoupled == 0) fprintf(fortran_out," use %s\n",newmodule->u_charusemodule); +*/ + fprintf(fortran_out," use %s\n", newmodule->u_charusemodule); + } + } + newmodule = newmodule ->suiv; + } +} diff --git a/CROCO/croco-v1.3.1/AGRIF/LIB/WorkWithlistvarindoloop.c b/CROCO/croco-v1.3.1/AGRIF/LIB/WorkWithlistvarindoloop.c new file mode 100644 index 00000000..54bfa8b5 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/LIB/WorkWithlistvarindoloop.c @@ -0,0 +1,1928 @@ +/******************************************************************************/ +/* */ +/* CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran) */ +/* */ +/* Copyright or or Copr. Laurent Debreu (Laurent.Debreu@imag.fr) */ +/* Cyril Mazauric (Cyril_Mazauric@yahoo.fr) */ +/* This software is governed by the CeCILL-C license under French law and */ +/* abiding by the rules of distribution of free software. You can use, */ +/* modify and/ or redistribute the software under the terms of the CeCILL-C */ +/* license as circulated by CEA, CNRS and INRIA at the following URL */ +/* "http://www.cecill.info". */ +/* */ +/* As a counterpart to the access to the source code and rights to copy, */ +/* modify and redistribute granted by the license, users are provided only */ +/* with a limited warranty and the software's author, the holder of the */ +/* economic rights, and the successive licensors have only limited */ +/* liability. */ +/* */ +/* In this respect, the user's attention is drawn to the risks associated */ +/* with loading, using, modifying and/or developing or reproducing the */ +/* software by the user in light of its specific status of free software, */ +/* that may mean that it is complicated to manipulate, and that also */ +/* therefore means that it is reserved for developers and experienced */ +/* professionals having in-depth computer knowledge. Users are therefore */ +/* encouraged to load and test the software's suitability as regards their */ +/* requirements in conditions enabling the security of their systems and/or */ +/* data to be ensured and, more generally, to use and operate it in the */ +/* same conditions as regards security. */ +/* */ +/* The fact that you are presently reading this means that you have had */ +/* knowledge of the CeCILL-C license and that you accept its terms. */ +/******************************************************************************/ +/* version 1.7 */ +/******************************************************************************/ +#include +//#include +//#include + +#include "decl.h" + +/******************************************************************************/ +/* Add_UsedInSubroutine_Var_1 */ +/******************************************************************************/ +/* Firstpass 1 */ +/* We should complete the List_UsedInSubroutine_Var */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +void Add_UsedInSubroutine_Var_1 (const char *ident) +{ + listvar *newvar; + listvar *tmpvar; + int out; + + /* In the first pass we record all variables presents in the do loop */ + if (firstpass == 1 && insubroutinedeclare == 1 ) + { + + if ( !List_UsedInSubroutine_Var ) + { + newvar=(listvar *)calloc(1,sizeof(listvar)); + newvar->var=(variable *)calloc(1,sizeof(variable)); + /* */ + Init_Variable(newvar->var); + /* */ + newvar->suiv = NULL; + strcpy(newvar->var->v_nomvar,ident); + strcpy(newvar->var->v_modulename,curmodulename); + strcpy(newvar->var->v_commoninfile,cur_filename); + strcpy(newvar->var->v_subroutinename,subroutinename); + newvar->var->v_pointedvar=pointedvar; + List_UsedInSubroutine_Var = newvar ; + } + else + { + /* We should verify that this variable did not added */ + tmpvar = List_UsedInSubroutine_Var; + out = 0 ; + while (tmpvar && out == 0 ) + { + if ( !strcasecmp(tmpvar->var->v_nomvar,ident) && + !strcasecmp(tmpvar->var->v_subroutinename,subroutinename)) + out = 1 ; + else tmpvar = tmpvar->suiv; + } + if ( out == 0 ) + { + newvar=(listvar *)calloc(1,sizeof(listvar)); + newvar->var=(variable *)calloc(1,sizeof(variable)); + /* */ + Init_Variable(newvar->var); + /* */ + strcpy(newvar->var->v_nomvar,ident); + strcpy(newvar->var->v_commoninfile,cur_filename); + strcpy(newvar->var->v_modulename,curmodulename); + strcpy(newvar->var->v_subroutinename,subroutinename); + newvar->var->v_pointedvar=pointedvar; + newvar->suiv = List_UsedInSubroutine_Var; + List_UsedInSubroutine_Var = newvar; + } + } + + } +} + +/******************************************************************************/ +/* AJOUTEVARINDOLOOP_DEFINEDIMENSION */ +/******************************************************************************/ +/* This subroutine is used to add a listvar to List_UsedInSubroutine_Var */ +/******************************************************************************/ +void ajoutevarindoloop_definedimension (char *name) +{ + listvar *newvar; + listvar *tmpvar; + listvar *tmpvarprec; + int out; + int tablemeet; + + if ( !List_UsedInSubroutine_Var ) + { + printf("LISTE VIDE\n"); + newvar=(listvar *)calloc(1,sizeof(listvar)); + newvar->var=(variable *)calloc(1,sizeof(variable)); + /* */ + Init_Variable(newvar->var); + /* */ + newvar->suiv = NULL; + strcpy(newvar->var->v_nomvar,name); + strcpy(newvar->var->v_modulename,curmodulename); + strcpy(newvar->var->v_commoninfile,cur_filename); + strcpy(newvar->var->v_subroutinename,subroutinename); + newvar->var->v_pointedvar=pointedvar; + List_UsedInSubroutine_Var = newvar ; + } + else + { + /* We should verify that this variable did not added */ + tmpvarprec = (listvar *)NULL; + tmpvar = List_UsedInSubroutine_Var; + out = 0 ; + tablemeet = 0 ; + while (tmpvar && out == 0 ) + { + if ( tablemeet == 0 && tmpvar->var->v_nbdim != 0 ) tablemeet = 1 ; + /* */ + if ( !strcasecmp(tmpvar->var->v_nomvar,name) && + !strcasecmp(tmpvar->var->v_subroutinename,subroutinename)) + { + out = 1 ; + /* if this variable has been define before a table we do nothing */ + /* else we should remove it */ + if ( tablemeet == 1 ) + { + tmpvarprec->suiv = tmpvar -> suiv; + out = 2; + } + } + else + { + tmpvarprec = tmpvar; + tmpvar = tmpvar->suiv; + } + } + + if ( out == 2 || out == 0 ) + { + newvar=(listvar *)calloc(1,sizeof(listvar)); + newvar->var=(variable *)calloc(1,sizeof(variable)); + /* */ + Init_Variable(newvar->var); + /* */ + strcpy(newvar->var->v_nomvar,name); + strcpy(newvar->var->v_modulename,curmodulename); + strcpy(newvar->var->v_commoninfile,cur_filename); + strcpy(newvar->var->v_subroutinename,subroutinename); + newvar->var->v_pointedvar=pointedvar; + + /* we should find this new variable to know the tabvars indice */ + + if ( variableisglobal(newvar, List_Global_Var) == 1 ) + { + newvar->suiv = List_UsedInSubroutine_Var; + List_UsedInSubroutine_Var = newvar; + } + else if ( variableisglobal(newvar, List_ModuleUsed_Var) == 1 ) + { + newvar->suiv = List_UsedInSubroutine_Var; + List_UsedInSubroutine_Var = newvar; + } + else if ( variableisglobal(newvar, List_Common_Var) == 1 ) + { + newvar->suiv = List_UsedInSubroutine_Var; + List_UsedInSubroutine_Var = newvar; + } + else + { + free(newvar); + } + } + } +} + +/******************************************************************************/ +/* ModifyThelistvarindoloop */ +/******************************************************************************/ +/* This subroutine is to give the old name to the which has been */ +/* declared as USE MOD, U => V in this case we should replace in the */ +/* name V by the old name U in the List_UsedInSubroutine_Var */ +/******************************************************************************/ +void ModifyThelistvarindoloop() +{ + listvar *newvar; + + newvar = List_UsedInSubroutine_Var; + while ( newvar ) + { + if ( strcasecmp(newvar->var->v_oldname,"") ) + { + strcpy(newvar->var->v_nomvar,newvar->var->v_oldname); + } + newvar = newvar->suiv; + } +} + +/******************************************************************************/ +/* CompleteThelistvarindoloop */ +/******************************************************************************/ +/* This subroutine is to add to the List_UsedInSubroutine_Var all variables */ +/* which has been declared as USE MOD, U => V in this case we should replace */ +/* in the List_UsedInSubroutine_Var the word U by the word V */ +/******************************************************************************/ +void CompleteThelistvarindoloop() +{ + listvar *newvar; + listvarpointtovar *pointtmplist; + listcouple *coupletmp; + int outvar; + + pointtmplist = List_CouplePointed_Var; + while ( pointtmplist ) + { + coupletmp = pointtmplist->t_couple; + while ( coupletmp ) + { + newvar = List_UsedInSubroutine_Var; + outvar = 0 ; + while ( newvar && outvar == 0) + { + /* we should find the same variable name in the same subroutine */ + if ( !strcasecmp(newvar->var->v_nomvar, coupletmp->c_namevar) && + !strcasecmp(newvar->var->v_subroutinename, pointtmplist->t_cursubroutine) && + strcasecmp(coupletmp->c_namepointedvar, "") ) + { + outvar = 1; + strcpy(newvar->var->v_oldname, newvar->var->v_nomvar); + strcpy(newvar->var->v_nomvar, coupletmp->c_namepointedvar); + } + else + { + newvar = newvar->suiv; + } + } + coupletmp = coupletmp->suiv; + } + pointtmplist = pointtmplist->suiv; + } +} + +/******************************************************************************/ +/* Merge_Variables */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +void Merge_Variables(variable *var1, variable *var2) +{ + + if ( !strcasecmp(var1->v_typevar,"") ) + strcpy(var1->v_typevar,var2->v_typevar); + else strcpy(var2->v_typevar,var1->v_typevar); + + if ( !strcasecmp(var1->v_oldname,"") ) + strcpy(var1->v_oldname,var2->v_oldname); + else strcpy(var2->v_oldname,var1->v_oldname); + + if ( !strcasecmp(var1->v_dimchar,"") ) + strcpy(var1->v_dimchar,var2->v_dimchar); + else strcpy(var2->v_dimchar,var1->v_dimchar); + + if ( !strcasecmp(var1->v_commonname,"") ) + strcpy(var1->v_commonname,var2->v_commonname); + else strcpy(var2->v_commonname,var1->v_commonname); + + if ( !strcasecmp(var1->v_modulename,"") || (var1->v_module ==0)) + strcpy(var1->v_modulename,var2->v_modulename); + else strcpy(var2->v_modulename,var1->v_modulename); + + if ( !strcasecmp(var1->v_vallengspec,"") ) + strcpy(var1->v_vallengspec,var2->v_vallengspec); + else strcpy(var2->v_vallengspec,var1->v_vallengspec); + + if ( !strcasecmp(var1->v_nameinttypename,"") ) + strcpy(var1->v_nameinttypename,var2->v_nameinttypename); + else strcpy(var2->v_nameinttypename,var1->v_nameinttypename); + + if ( !strcasecmp(var1->v_commoninfile,"") ) + strcpy(var1->v_commoninfile,var2->v_commoninfile); + else strcpy(var2->v_commoninfile,var1->v_commoninfile); + + if ( !strcasecmp(var1->v_precision,"") ) + strcpy(var1->v_precision,var2->v_precision); + else strcpy(var2->v_precision,var1->v_precision); + +// if ( !strcasecmp(var1->v_initialvalue,"") ) +// strcpy(var1->v_initialvalue,var2->v_initialvalue); +// else strcpy(var2->v_initialvalue,var1->v_initialvalue); + + if ( var1->v_initialvalue ) + var2->v_initialvalue = var1->v_initialvalue; + else var1->v_initialvalue = var2->v_initialvalue; + + if ( var1->v_initialvalue_array ) + var2->v_initialvalue_array = var1->v_initialvalue_array; + else var1->v_initialvalue_array = var2->v_initialvalue_array; + + if ( var1->v_do_loop ) + var2->v_do_loop = var1->v_do_loop; + else var1->v_do_loop = var2->v_do_loop; + +// if ( !strcasecmp(var1->v_initialvalue_array,"") ) +// strcpy(var1->v_initialvalue_array,var2->v_initialvalue_array); +// else strcpy(var2->v_initialvalue_array,var1->v_initialvalue_array); + + if ( !strcasecmp(var1->v_IntentSpec,"") ) + strcpy(var1->v_IntentSpec,var2->v_IntentSpec); + else strcpy(var2->v_IntentSpec,var1->v_IntentSpec); + + if ( !strcasecmp(var1->v_readedlistdimension,"") ) + strcpy(var1->v_readedlistdimension,var2->v_readedlistdimension); + else strcpy(var2->v_readedlistdimension,var1->v_readedlistdimension); + + if ( var1->v_dimension ) + var2->v_dimension = var1->v_dimension ; + else var1->v_dimension = var2->v_dimension ; + + if ( var1->v_nbdim == 0 ) + var1->v_nbdim = var2->v_nbdim ; + else var2->v_nbdim = var1->v_nbdim ; + + if ( var1->v_common == 0 ) + var1->v_common = var2->v_common ; + else var2->v_common = var1->v_common ; + + if ( var1->v_positioninblock == 0 ) + var1->v_positioninblock = var2->v_positioninblock ; + else var2->v_positioninblock = var1->v_positioninblock ; + + if ( var1->v_module == 0 ) + var1->v_module = var2->v_module ; + else var2->v_module = var1->v_module ; + + if ( var1->v_save == 0 ) + var1->v_save = var2->v_save ; + else var2->v_save = var1->v_save ; + + if ( var1->v_VariableIsParameter == 0 ) + var1->v_VariableIsParameter = var2->v_VariableIsParameter ; + else var2->v_VariableIsParameter = var1->v_VariableIsParameter ; + + if ( var1->v_indicetabvars == 0 ) + var1->v_indicetabvars = var2->v_indicetabvars ; + else var2->v_indicetabvars = var1->v_indicetabvars ; + + if ( var1->v_ExternalDeclare == 0 ) + var1->v_ExternalDeclare = var2->v_ExternalDeclare ; + else var2->v_ExternalDeclare = var1->v_ExternalDeclare ; + + if ( var1->v_pointedvar == 0 ) + var1->v_pointedvar = var2->v_pointedvar ; + else var2->v_pointedvar = var1->v_pointedvar ; + + if ( var1->v_dimensiongiven == 0 ) + var1->v_dimensiongiven = var2->v_dimensiongiven; + else var2->v_dimensiongiven = var1->v_dimensiongiven ; + + if ( var1->v_c_star == 0 ) + var1->v_c_star = var2->v_c_star; + else var2->v_c_star = var1->v_c_star ; + + if ( var1->v_catvar == 0 ) + var1->v_catvar = var2->v_catvar; + else var2->v_catvar = var1->v_catvar ; + + if ( var1->v_pointerdeclare == 0 ) + var1->v_pointerdeclare = var2->v_pointerdeclare ; + else var2->v_pointerdeclare = var1->v_pointerdeclare ; + + if ( var1->v_notgrid == 0 ) + var1->v_notgrid = var2->v_notgrid ; + else var2->v_notgrid = var1->v_notgrid; + + if ( var1->v_optionaldeclare == 0 ) + var1->v_optionaldeclare = var2->v_optionaldeclare; + else var2->v_optionaldeclare = var1->v_optionaldeclare ; + + if ( var1->v_allocatable == 0 ) + var1->v_allocatable = var2->v_allocatable ; + else var2->v_allocatable = var1->v_allocatable ; + + if ( var1->v_target == 0 ) + var1->v_target = var2->v_target ; + else var2->v_target = var1->v_target ; + + if ( var1->v_dimsempty == 0 ) + var1->v_dimsempty = var2->v_dimsempty ; + else var2->v_dimsempty = var1->v_dimsempty ; +} + + +/******************************************************************************/ +/* Update_List_Subroutine_Var */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +void Update_List_Subroutine_Var(listvar *list_to_modify) +{ + listvar *parcours; + listvar *parcoursprec; + listvar *parcours1; + int out; + + parcoursprec = (listvar *)NULL; + parcours = list_to_modify; + while( parcours ) + { + /* looking in List_SubroutineDeclaration_Var */ + parcours1 = List_SubroutineDeclaration_Var; + out = 0; + while ( parcours1 && out == 0 ) + { + if ( !strcasecmp(parcours->var->v_nomvar, parcours1->var->v_nomvar) && + !strcasecmp(parcours->var->v_subroutinename, parcours1->var->v_subroutinename) && + !strcasecmp(parcours->var->v_modulename, parcours1->var->v_modulename) + ) out = 1; + else parcours1 = parcours1->suiv; + } + /* if variable has been found */ + + if ( out == 1 ) Merge_Variables(parcours->var,parcours1->var); + + /* looking in List_Dimension_Var */ + if (out == 0 ) + { + parcours1 = List_Dimension_Var; + out = 0; + while ( parcours1 && out == 0 ) + { + if ( !strcasecmp(parcours->var->v_nomvar, + parcours1->var->v_nomvar) && + !strcasecmp(parcours->var->v_subroutinename, + parcours1->var->v_subroutinename) && + !strcasecmp(parcours->var->v_modulename, + parcours1->var->v_modulename) + ) out = 1; + else + { + parcoursprec = parcours1; + parcours1 = parcours1->suiv; + } + } + /* if variable has been found */ + + if ( out == 1 ) + { + Merge_Variables(parcours->var,parcours1->var); + /* we should remove this record from the List_Dimension_Var */ + if ( parcours1 == List_Dimension_Var ) + { + List_Dimension_Var = List_Dimension_Var -> suiv; + } + else + { + parcoursprec->suiv = parcours1 -> suiv; + } + } + } + /* */ + parcours = parcours->suiv; + } +} + +void Update_List_Global_Var_From_List_Save_Var() +{ + listvar *parcours; + listvar *newvar; + char tmpname[LONG_VNAME]; + + parcours = List_Save_Var; + while( parcours ) + { + if ( !strcasecmp(parcours->var->v_modulename,"") ) + /* Save in subroutine which is not defined in a module */ + { + newvar = (listvar *)calloc(1,sizeof(listvar)); + newvar->var = (variable *)calloc(1,sizeof(variable)); + /* */ + Init_Variable(newvar->var); + /* */ + newvar->suiv = NULL; + + Merge_Variables(parcours->var,newvar->var); + strcpy(newvar->var->v_subroutinename,parcours->var->v_subroutinename); + strcpy(newvar->var->v_nomvar,parcours->var->v_nomvar); + newvar->var->v_catvar=parcours->var->v_catvar; + sprintf(tmpname,"save_%s",parcours->var->v_subroutinename); + Add_NameOfCommon_1(tmpname,parcours->var->v_subroutinename); + strcpy(newvar->var->v_commonname,tmpname); + List_Common_Var = AddListvarToListvar(newvar,List_Common_Var,1); + } + else + /* Save in subroutine which is defined in a module */ + { + newvar = (listvar *)calloc(1,sizeof(listvar)); + newvar->var = (variable *)calloc(1,sizeof(variable)); + /* */ + Init_Variable(newvar->var); + /* */ + newvar->suiv = NULL; + + Merge_Variables(parcours->var,newvar->var); + strcpy(newvar->var->v_subroutinename,parcours->var->v_subroutinename); + + strcpy(newvar->var->v_nomvar,parcours->var->v_nomvar); + + newvar->var->v_catvar=parcours->var->v_catvar; + strcpy(newvar->var->v_modulename,parcours->var->v_modulename); + List_Global_Var = AddListvarToListvar(newvar,List_Global_Var,1); + } + parcours = parcours->suiv; + } +} + +/******************************************************************************/ +/* Update_List_From_Common_Var */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +void Update_List_From_Common_Var(listvar *list_to_modify) +{ + listvar *parcours; + listvar *parcours1; + int out; + parcours = list_to_modify; + while( parcours ) + { + /* looking in List_Global_Var */ + parcours1 = List_Common_Var; + out = 0; + while ( parcours1 && out == 0 ) + { + + if ( !strcasecmp(parcours->var->v_nomvar, parcours1->var->v_nomvar) && + !strcasecmp(parcours->var->v_subroutinename, parcours1->var->v_subroutinename) ) + { + out = 1; + } + else parcours1 = parcours1->suiv; + } + /* if variable has been found */ + if ( out == 1 ) + { + strcpy(parcours->var->v_commoninfile,parcours1->var->v_commoninfile); + + Merge_Variables(parcours->var,parcours1->var); + } + parcours = parcours->suiv; + } +} + +/******************************************************************************/ +/* Update_List_Var */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +void Update_List_Var(listvar *list_to_modify) +{ + listvar *parcours; + listvar *parcours1; + int out; + + parcours = list_to_modify; + + while( parcours ) + { + /*printf("LE NOM EST %s\n",parcours->var->v_nomvar);*/ + /* looking in List_Global_Var */ + out = 0; + parcours1 = List_Global_Var; + + while ( parcours1 && out == 0 ) + { + if ( !strcasecmp(parcours->var->v_nomvar, parcours1->var->v_nomvar) && + !strcasecmp(parcours->var->v_subroutinename, parcours1->var->v_subroutinename) && + !strcasecmp(parcours->var->v_modulename, parcours1->var->v_modulename) ) + { + out = 1; + } + else parcours1 = parcours1->suiv; + } + + /* if variable has been found */ + if ( out == 1 ) + { + Merge_Variables(parcours->var,parcours1->var); + } + /* looking in List_SubroutineDeclaration_Var */ + else + { + parcours1 = List_SubroutineDeclaration_Var ; + out = 0; + while ( parcours1 ) + { + if ( !strcasecmp(parcours->var->v_nomvar, parcours1->var->v_nomvar) && + !strcasecmp(parcours->var->v_subroutinename, parcours1->var->v_subroutinename) && + !strcasecmp(parcours->var->v_modulename, parcours1->var->v_modulename) ) + { + out = 1; + break; + } + else parcours1 = parcours1->suiv; + } + /* if variable has been found */ + if ( out == 1 ) + { + Merge_Variables(parcours->var,parcours1->var); + } + else + { + parcours1 = List_Common_Var ; + out = 0; + while ( parcours1 && out == 0 ) + { + if ( !strcasecmp(parcours->var->v_nomvar, parcours1->var->v_nomvar) && + !strcasecmp(parcours->var->v_subroutinename, parcours1->var->v_subroutinename) && + !strcasecmp(parcours->var->v_modulename, parcours1->var->v_modulename) ) + { + out = 1; + } + else parcours1 = parcours1->suiv; + } + /* if variable has been found */ + if ( out == 1 ) + { + Merge_Variables(parcours->var,parcours1->var); + } + } + } + parcours = parcours->suiv; + } +} + + +void List_UsedInSubroutine_Var_Update_From_Module_Used() +{ + listvar *parcours; + listvar *parcours3; + listusemodule *parcours2; + int out; + + + parcours = List_UsedInSubroutine_Var; + while( parcours ) + { + out = 0 ; + if ( parcours->var->v_indicetabvars == 0 ) + { + parcours2 = List_NameOfModuleUsed; + while( parcours2 ) + { + if ( !strcasecmp(parcours2->u_cursubroutine, "") && + !strcasecmp(parcours2->u_modulename, parcours->var->v_modulename) ) + { + parcours3 = List_Global_Var; + out = 0 ; + while ( parcours3 && out == 0 ) + { + if ( !strcasecmp(parcours->var->v_nomvar, + parcours3->var->v_nomvar) + ) out = 1 ; + else parcours3 = parcours3->suiv; + } + if ( out == 1 ) Merge_Variables(parcours->var,parcours3->var); + } + else if ( !strcasecmp(parcours2->u_cursubroutine, parcours->var->v_subroutinename) && + !strcasecmp(parcours2->u_modulename, parcours->var->v_modulename) ) + { + parcours3 = List_Global_Var; + out = 0 ; + while ( parcours3 && out == 0 ) + { + if ( !strcasecmp(parcours->var->v_nomvar, + parcours3->var->v_nomvar) + ) out = 1 ; + else parcours3 = parcours3->suiv; + } + if ( out == 1 ) Merge_Variables(parcours->var,parcours3->var); + } + parcours2 = parcours2->suiv; + } + /* */ + if ( out == 0 ) + { + parcours3 = List_ModuleUsed_Var; + out = 0 ; + while ( parcours3 && out == 0 ) + { + if ( !strcasecmp(parcours->var->v_nomvar, + parcours3->var->v_nomvar) + ) out = 1 ; + else parcours3 = parcours3->suiv; + } + if ( out == 1 ) Merge_Variables(parcours->var,parcours3->var); + } + /* */ + } + parcours = parcours->suiv; + } +} + + + +/******************************************************************************/ +/* Update_NotGridDepend_Var */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +void Update_NotGridDepend_Var(listvar *list_to_modify) +{ + listvar *parcours; + listvar *parcours1; + int out; + + parcours = list_to_modify; + while( parcours ) + { + /* looking in List_Global_Var */ + parcours1 = List_Global_Var; + out = 0; + while ( parcours1 && out == 0 ) + { + if ( !strcasecmp(parcours->var->v_nomvar, + parcours1->var->v_nomvar) + ) out = 1; + else parcours1 = parcours1->suiv; + } + /* if variable has been found */ + if ( out == 1 ) + { + Merge_Variables(parcours->var,parcours1->var); + strcpy(parcours->var->v_subroutinename, + parcours1->var->v_subroutinename); + strcpy(parcours->var->v_modulename,parcours1->var->v_modulename); + } + parcours = parcours->suiv; + } +} + +int LookingForVariableInList(listvar *listin,variable *var) +{ + listvar *parcours1; + int out; + + parcours1 = listin; + out = 0 ; + while ( parcours1 && out == 0 ) + { + if ( !strcasecmp(var->v_nomvar,parcours1->var->v_nomvar) && + !strcasecmp(var->v_subroutinename,parcours1->var->v_subroutinename)&& + !strcasecmp(var->v_modulename,parcours1->var->v_modulename) && + var->v_save == 0 && + var->v_common == 0 + ) out = 1 ; + else parcours1 = parcours1 -> suiv; + } + + return out; +} + +int LookingForVariableInListGlobal(listvar *listin,variable *var) +{ + listvar *parcours1; + int out; + + parcours1 = listin; + out = 0 ; + while ( parcours1 && out == 0 ) + { + if ( !strcasecmp(var->v_nomvar,parcours1->var->v_nomvar) && + !strcasecmp(var->v_subroutinename,parcours1->var->v_subroutinename)&& + !strcasecmp(var->v_modulename,parcours1->var->v_modulename) + ) out = 1 ; + else parcours1 = parcours1 -> suiv; + } + + return out; +} + +int LookingForVariableInListName(listvar *listin,const char *name) +{ + listvar *parcours1; + int out; + + parcours1 = listin; + out = 0 ; + while ( parcours1 && out == 0 ) + { + if ( !strcasecmp(name,parcours1->var->v_nomvar) && + ( !strcasecmp(subroutinename,parcours1->var->v_subroutinename) || + !strcasecmp(subroutinename,"") ) + ) out = 1 ; + else parcours1 = parcours1 -> suiv; + } + + return out; +} + +variable *get_variable_in_list_from_name( listvar *listin, const char *name ) +{ + listvar *parcours = listin; + variable *var = NULL; + + while ( parcours && (!var) ) + { + if ( !strcasecmp(name,parcours->var->v_nomvar) && + ( !strcasecmp(subroutinename,parcours->var->v_subroutinename) || + !strcasecmp(subroutinename,"") ) ) + { + var = parcours->var; + } + else parcours = parcours -> suiv; + } + return var; +} + +int LookingForVariableInListGlob(listvar *listin,variable *var) +{ + listvar *parcours1; + int out; + + parcours1 = listin; + out = 0 ; + while ( parcours1 && out == 0 ) + { + if ( !strcasecmp(var->v_nomvar,parcours1->var->v_nomvar) && + !strcasecmp(var->v_modulename,parcours1->var->v_modulename) + ) out = 1 ; + else parcours1 = parcours1 -> suiv; + } + + return out; +} + +int LookingForVariableInListParamGlob(listparameter *listin,variable *var) +{ + listparameter *parcours1; + int out; + + parcours1 = listin; + out = 0 ; + while ( parcours1 && out == 0 ) + { + if ( !strcasecmp(var->v_nomvar,parcours1->p_name) + ) out = 1 ; + else parcours1 = parcours1 -> suiv; + } + + return out; +} + +void UpdateListDeclarationWithDimensionList() +{ + List_SubroutineDeclaration_Var = AddListvarToListvar(List_Dimension_Var, List_SubroutineDeclaration_Var,1); +} + + +/* Remove from List_UsedInSubroutine_Var all variables comming from : */ +/* - List_SubroutineArgument_Var */ +/* - List_SubroutineDeclaration_Var */ +/* - List_Parameter_Var */ +/* - List_FunctionType_Var */ +/* - List_GlobalParameter_Var */ +/* - */ +/* - */ +void Clean_List_UsedInSubroutine_Var() +{ + listvar *parcours; + listvar *parcoursprec; + int remove; + + parcoursprec = (listvar *)NULL; + parcours = List_UsedInSubroutine_Var; + while ( parcours ) + { + remove = LookingForVariableInListGlobal(List_SubroutineArgument_Var, parcours->var); + if ( remove == 0 ) + remove = LookingForVariableInList(List_SubroutineDeclaration_Var, parcours->var); + if ( remove == 0 ) + remove = LookingForVariableInList(List_Parameter_Var, parcours->var); + if ( remove == 0 ) + remove = LookingForVariableInList(List_FunctionType_Var, parcours->var); + if ( remove == 0 ) + remove = LookingForVariableInListGlob(List_GlobalParameter_Var, parcours->var); + if ( remove == 0 ) + remove = LookingForVariableInListParamGlob(List_GlobParamModuleUsed_Var, parcours->var); + if ( remove == 0 ) + { + if ( VariableIsInList(parcours,List_Global_Var) == 1 || + VariableIsInListCommon(parcours,List_Common_Var) == 1 || + VariableIsInList(parcours,List_ModuleUsed_Var) == 1 || + VariableIsInList(parcours,List_ModuleUsedInModuleUsed_Var) == 1 + ) remove = 0; + else remove = 1; + } + + /************************************************************************/ + /* Remove */ + /************************************************************************/ + + if ( remove == 1 ) + { + if ( parcours == List_UsedInSubroutine_Var ) + { + List_UsedInSubroutine_Var = List_UsedInSubroutine_Var -> suiv; + parcours = List_UsedInSubroutine_Var; + } + else + { + parcoursprec->suiv = parcours->suiv; + parcours = parcoursprec -> suiv ; + } + } + else + { + parcoursprec = parcours; + parcours = parcours -> suiv ; + } + } +} + + +void Clean_List_ModuleUsed_Var() +{ + listvar *parcours; + listvar *parcours1; + listvar *parcoursprec; + int remove; + + parcoursprec = (listvar *)NULL; + parcours = List_ModuleUsed_Var; + while ( parcours ) + { + /* */ + parcours1 = List_GlobalParameter_Var; + remove = 0 ; + while ( parcours1 && remove == 0 ) + { + if ( !strcasecmp(parcours->var->v_nomvar,parcours1->var->v_nomvar) + ) remove = 1 ; + else parcours1 = parcours1 -> suiv; + } + /************************************************************************/ + /* Remove */ + /************************************************************************/ + if ( remove == 1 ) + { + if ( parcours == List_ModuleUsed_Var ) + { + List_ModuleUsed_Var = List_ModuleUsed_Var -> suiv; + parcours = List_ModuleUsed_Var; + } + else + { + parcoursprec->suiv = parcours->suiv; + parcours = parcoursprec -> suiv ; + } + } + else + { + parcoursprec = parcours; + parcours = parcours -> suiv ; + } + } +} + +void Clean_List_SubroutineDeclaration_Var() +{ + listvar *parcours; + listvar *parcours1; + listvar *parcoursprec; + int out ; + + parcoursprec = (listvar *)NULL; + parcours = List_SubroutineDeclaration_Var; + while ( parcours ) + { + parcours1 = List_FunctionType_Var; + out = 0 ; + while ( parcours1 && out == 0 ) + { + if ( !strcasecmp(parcours->var->v_subroutinename,parcours1->var->v_subroutinename) && + !strcasecmp(parcours->var->v_nomvar,parcours1->var->v_nomvar) + ) out = 1; + else parcours1 = parcours1->suiv; + } + if ( out == 0 ) + { + parcours1 = List_SubroutineArgument_Var; + out = 0 ; + while ( parcours1 && out == 0 ) + { + if ( !strcasecmp(parcours->var->v_subroutinename,parcours1->var->v_subroutinename) && + !strcasecmp(parcours->var->v_nomvar,parcours1->var->v_nomvar) + ) out = 1; + else parcours1 = parcours1->suiv; + } + } + + if ( out == 1 ) + { + if ( parcours == List_SubroutineDeclaration_Var ) + { + List_SubroutineDeclaration_Var = + List_SubroutineDeclaration_Var -> suiv; + parcours = List_SubroutineDeclaration_Var; + } + else + { + parcoursprec->suiv = parcours->suiv; + parcours = parcoursprec->suiv; + } + } + else + { + parcoursprec = parcours; + parcours = parcours -> suiv; + } + } +} + +void Clean_List_Global_Var() +{ + listvar *parcours; + listvar *parcours2; + listvar *parcoursprec; + listvar *parcours2prec; + + parcoursprec = (listvar *)NULL; + parcours2prec = (listvar *)NULL; + parcours = List_Global_Var; + while ( parcours ) + { + if ( parcours->var->v_VariableIsParameter == 1 ) + { + /* remove */ + if ( parcours == List_Global_Var ) + { + List_Global_Var = List_Global_Var->suiv; + free(parcours); + parcours = List_Global_Var; + } + else + { + parcoursprec->suiv = parcours->suiv; + free(parcours); + parcours = parcoursprec->suiv; + } + } + else + { + parcoursprec = parcours; + parcours = parcours->suiv; + } + } + /* looking for sevral declaration of the same variable */ + parcours = List_Global_Var; + while ( parcours ) + { + parcours2prec = parcours; + parcours2 = parcours->suiv; + while ( parcours2 ) + { + if ( !strcasecmp(parcours->var->v_nomvar, + parcours2->var->v_nomvar) && + !strcasecmp(parcours->var->v_modulename, + parcours2->var->v_modulename) ) + { + Merge_Variables(parcours->var,parcours2->var); + /* remove var from the parcours2 */ + parcours2prec ->suiv = parcours2->suiv; + free(parcours2); + parcours2 = parcours2prec ->suiv; + } + else + { + parcours2prec = parcours2; + parcours2 = parcours2->suiv; + } + } + parcours = parcours->suiv; + } +} +/******************************************************************************/ +/* ListClean */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +void ListClean() +{ + listvar *newvar; + + Clean_List_ModuleUsed_Var(); + Clean_List_UsedInSubroutine_Var(); + Clean_List_SubroutineDeclaration_Var(); + + newvar = (listvar *)NULL; +/* newvar = List_Common_Var;*/ + while(newvar) + { + printf("----- %s --- %s ---%s---%s---\n",newvar->var->v_nomvar, + newvar->var->v_commonname, + newvar->var->v_readedlistdimension, + newvar->var->v_subroutinename + ); + newvar = newvar -> suiv; + printf("+++++++++++++++++++++++++\n"); + } + +} + + +/******************************************************************************/ +/* ListUpdate */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +void ListUpdate() +{ + listvar *newvar; + + Update_List_Subroutine_Var(List_SubroutineArgument_Var); + Update_List_Subroutine_Var(List_FunctionType_Var); + Update_List_Var(List_Parameter_Var); + Update_List_Var(List_Dimension_Var); + Update_List_Var(List_Data_Var); + Update_List_Var(List_Save_Var); + Update_List_Var(List_GlobalParameter_Var); + Update_List_Var(List_Common_Var); + Update_List_Var(List_SubroutineDeclaration_Var); + Update_List_Var(List_UsedInSubroutine_Var); + Update_List_From_Common_Var(List_UsedInSubroutine_Var); + Update_List_From_Common_Var(List_SubroutineDeclaration_Var); + Update_NotGridDepend_Var(List_NotGridDepend_Var); + + newvar = (listvar * ) NULL; +// newvar = List_Common_Var; +// newvar = List_UsedInSubroutine_Var; +// newvar = List_Data_Var; + while ( newvar ) + { + printf("++++ %s - %s - %s - %d - %s - %s\n", + newvar->var->v_modulename, + newvar->var->v_subroutinename, + newvar->var->v_nomvar, + newvar->var->v_VariableIsParameter, + newvar->var->v_typevar, + newvar->var->v_initialvalue->n_name ); + newvar = newvar->suiv; + } +} + +void GiveTypeOfVariables() +{ + listvar *parcours; + + /* */ + parcours = List_Common_Var; + while ( parcours ) + { + if ( !strcasecmp(parcours->var->v_typevar,"") ) + { + if ( IsVariableReal(parcours->var->v_nomvar) == 1 ) + strcpy(parcours->var->v_typevar,"REAL"); + else strcpy(parcours->var->v_typevar,"INTEGER"); + parcours->var->v_catvar = get_cat_var(parcours->var); + } + parcours = parcours -> suiv ; + } + /* */ + parcours = List_UsedInSubroutine_Var; + while ( parcours ) + { + if ( !strcasecmp(parcours->var->v_typevar,"") ) + { + if ( IsVariableReal(parcours->var->v_nomvar) == 1 ) + strcpy(parcours->var->v_typevar,"REAL"); + else strcpy(parcours->var->v_typevar,"INTEGER"); + parcours->var->v_catvar = get_cat_var(parcours->var); + } + parcours = parcours -> suiv ; + } + /* */ + parcours = List_SubroutineArgument_Var; + while ( parcours ) + { + if ( !strcasecmp(parcours->var->v_typevar,"") ) + { + if ( IsVariableReal(parcours->var->v_nomvar) == 1 ) + strcpy(parcours->var->v_typevar,"REAL"); + else strcpy(parcours->var->v_typevar,"INTEGER"); + parcours->var->v_catvar = get_cat_var(parcours->var); + } + parcours = parcours -> suiv ; + } + /* */ + parcours = List_SubroutineDeclaration_Var; + while ( parcours ) + { + if ( !strcasecmp(parcours->var->v_typevar,"") ) + { + if ( IsVariableReal(parcours->var->v_nomvar) == 1 ) + strcpy(parcours->var->v_typevar,"REAL"); + else strcpy(parcours->var->v_typevar,"INTEGER"); + parcours->var->v_catvar = get_cat_var(parcours->var); + } + parcours = parcours -> suiv ; + } + + /* */ + parcours = List_Parameter_Var; + while ( parcours ) + { + if ( !strcasecmp(parcours->var->v_typevar,"") ) + { + if ( IsVariableReal(parcours->var->v_nomvar) == 1 ) + strcpy(parcours->var->v_typevar,"REAL"); + else strcpy(parcours->var->v_typevar,"INTEGER"); + parcours->var->v_catvar = get_cat_var(parcours->var); + } + parcours = parcours -> suiv ; + } + + /* */ + parcours = List_GlobalParameter_Var; + while ( parcours ) + { + if ( !strcasecmp(parcours->var->v_typevar,"") ) + { + if ( IsVariableReal(parcours->var->v_nomvar) == 1 ) + strcpy(parcours->var->v_typevar,"REAL"); + else strcpy(parcours->var->v_typevar,"INTEGER"); + parcours->var->v_catvar = get_cat_var(parcours->var); + } + parcours = parcours -> suiv ; + } + +} + + + +void Sort_List_SubroutineArgument_Var() +{ + listvar *parcours; + listvar *parcours1; + int position; + int out; + char name_sub[LONG_M]; + + parcours = List_SubroutineArgument_Var; + position = 1; + while ( parcours ) + { + parcours1 = List_SubroutineDeclaration_Var; + out = 0; + while ( parcours1 && out == 0 ) + { + if ( !strcasecmp(parcours->var->v_nomvar, + parcours1->var->v_nomvar) && + !strcasecmp(parcours->var->v_subroutinename, + parcours1->var->v_subroutinename) + ) + { + parcours1->var->v_positioninblock = position; + position = position +1 ; + out = 1; + } + else parcours1 = parcours1->suiv; + } + parcours = parcours->suiv; + } + /* */ + parcours = List_SubroutineDeclaration_Var; + strcpy(name_sub,""); + while ( parcours ) + { + if ( !strcasecmp(name_sub,"") ) + { + strcpy(name_sub,parcours->var->v_subroutinename); + position = 1; + } + + if ( parcours->var->v_positioninblock != 0 ) + { + parcours1 = List_SubroutineArgument_Var; + out = 0; + while ( parcours1 && out == 0 ) + { + if ( !strcasecmp(parcours->var->v_nomvar, + parcours1->var->v_nomvar) && + !strcasecmp(parcours->var->v_subroutinename, + parcours1->var->v_subroutinename) + ) + { + parcours1->var->v_positioninblock = position; + position = position +1 ; + out = 1; + } + else parcours1 = parcours1->suiv; + } + } + if ( parcours->suiv ) + if ( strcasecmp(name_sub,parcours->suiv->var->v_subroutinename) ) + strcpy(name_sub,""); + parcours = parcours->suiv; + } + +} + + + +/******************************************************************************/ +/* IndiceTabvars_Global_Var_Treated */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +void IndiceTabvars_Global_Var_Treated(char *nom) +{ + listvar *parcours; + listvar *parcoursprec; + listvar *parcours1; + listvar *List_ModuleUsed_Var; + listindice *newindice; + int out; + + parcoursprec = (listvar *)NULL; + + if ( todebug == 1 ) printf("MODULE Treated %s \n",nom); + + List_ModuleUsed_Var = (listvar *)NULL; + List_ModuleUsed_Var = Readthedependfile(nom,List_ModuleUsed_Var); + + parcours = List_Global_Var; + while( parcours ) + { + if ( !strcasecmp(parcours->var->v_modulename,nom) ) + { + parcours1 = List_ModuleUsed_Var; + out = 0 ; + while ( parcours1 && out == 0 ) + { + if ( !strcasecmp(parcours->var->v_nomvar,parcours1->var->v_nomvar) + ) out = 1; + else + { + parcoursprec = parcours1 ; + parcours1 = parcours1->suiv; + } + } + /* if we found the var Module name in the old list */ + if ( out == 1 ) + { + Merge_Variables(parcours->var,parcours1->var); + /* Remove this variable from the List_ModuleUsed_Var */ + if ( parcours1 == List_ModuleUsed_Var ) + { + List_ModuleUsed_Var = List_ModuleUsed_Var->suiv ; + } + else + { + parcoursprec->suiv = parcours1->suiv; + free(parcours1); + parcours1 = parcoursprec->suiv; + } + } + else + /* if we do not found the var Module name in the old list */ + { + // update_indicemaxtabvars(parcours->var,Listofavailableindices); + update_indicemaxtabvars(parcours->var,Listofavailableindices_glob); + // if ( Listofavailableindices ) + // { + // parcours->var->v_indicetabvars = Listofavailableindices -> + // i_indice; + // if ( Listofavailableindices->suiv ) + // Listofavailableindices = Listofavailableindices->suiv; + // else + // Listofavailableindices = (listindice *)NULL; + // } + // else + // { + // indicemaxtabvars = indicemaxtabvars + 1 ; + // parcours->var->v_indicetabvars = indicemaxtabvars; + // } + } + } + parcours = parcours->suiv; + } + /* if List_ModuleUsed_Var is not empty, some var have been removed from */ + /* the last treatement */ + parcours1 = List_ModuleUsed_Var; + while ( parcours1 ) + { + newindice=(listindice *) calloc(1,sizeof(listindice)); + newindice -> i_indice = parcours1 -> var -> v_indicetabvars; + newindice -> suiv = Listofavailableindices_glob[parcours1 -> var -> v_catvar]; + Listofavailableindices_glob[parcours1 -> var -> v_catvar] = newindice; + parcours1 = parcours1->suiv; + } +} +/******************************************************************************/ +/* IndiceTabvars_Global_Var_No_Treated */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +void IndiceTabvars_Global_Var_No_Treated(char *nom) +{ + listvar *parcours; + + if ( todebug == 1 ) printf("MODULE No Treated %s \n",nom); + + parcours = List_Global_Var; + while( parcours ) + { + if ( !strcasecmp(parcours->var->v_modulename,nom) && + parcours->var->v_VariableIsParameter == 0 && + parcours->var->v_notgrid == 0 + ) + { + indicemaxtabvars[parcours->var->v_catvar] = indicemaxtabvars[parcours->var->v_catvar] + 1 ; + parcours->var->v_indicetabvars = indicemaxtabvars[parcours->var->v_catvar]; + } + parcours = parcours->suiv; + } +} + + +void UpdateTheRemainingList(listvar *record) +{ + listvar *parcours; + + parcours = record; + while ( parcours ) + { + if ( !strcasecmp(parcours->var->v_nomvar,record->var->v_nomvar) && + !strcasecmp(parcours->var->v_commonname,record->var->v_commonname) + ) + { + strcpy(parcours->var->v_commoninfile,record->var->v_commoninfile); + Merge_Variables(parcours->var,record->var); + } + parcours = parcours -> suiv; + } +} + + + +/******************************************************************************/ +/* IndiceTabvars_Common_Var_Treated */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +void IndiceTabvars_Common_Var_Treated(char *nom) +{ + listvar *parcours; + listvar *parcours1; + listvar *List_CommonUsed_Var; + listindice *newindice; + int out; + + if ( todebug == 1 ) printf("COMMON Treated %s \n",nom); + + List_CommonUsed_Var = (listvar *)NULL; + List_CommonUsed_Var = Readthedependfile(nom,List_CommonUsed_Var); + + parcours = List_Common_Var; + while( parcours ) + { + if ( !strcasecmp(parcours->var->v_commonname,nom) ) + { + parcours1 = List_CommonUsed_Var; + out = 0 ; + while ( parcours1 && out == 0 ) + { + + if ( !strcasecmp(parcours1->var->v_commonname,nom) && + !strcasecmp(parcours->var->v_nomvar,parcours1->var->v_nomvar) + ) out = 1; + else + { + parcours1 = parcours1->suiv; + } + } + /* if we found the var common name in the old list */ + if ( out == 1 ) + { + strcpy(parcours->var->v_commoninfile, + parcours1->var->v_commoninfile); + Merge_Variables(parcours->var,parcours1->var); + } + else + /* if we do not found the var common name in the old list */ + { + // update_indicemaxtabvars(parcours->var,Listofavailableindices); + update_indicemaxtabvars(parcours->var,Listofavailableindices_glob); + // if ( Listofavailableindices ) + // { + // parcours->var->v_indicetabvars = Listofavailableindices -> + // i_indice; + // if ( Listofavailableindices->suiv ) + // Listofavailableindices = Listofavailableindices->suiv; + // else + // Listofavailableindices = (listindice *)NULL; + // } + // else + // { + // indicemaxtabvars = indicemaxtabvars + 1 ; + // parcours->var->v_indicetabvars = indicemaxtabvars; + // } + } + /* Look in the remaining list in the variable is define */ + UpdateTheRemainingList(parcours); + } + parcours = parcours->suiv; + } + /* if List_CommonUsed_Var is not empty, some var have been removed from */ + /* the last treatement */ + parcours1 = List_CommonUsed_Var; + while ( parcours1 ) + { + if ( parcours1 -> var -> v_indicetabvars == 0 ) + { + newindice=(listindice *) calloc(1,sizeof(listindice)); + newindice -> i_indice = parcours1 -> var -> v_indicetabvars; + newindice -> suiv = Listofavailableindices_glob[parcours1 -> var -> v_catvar]; + Listofavailableindices_glob[parcours1 -> var -> v_catvar] = newindice; + } + parcours1 = parcours1->suiv; + } +} + +void update_indicemaxtabvars(variable *var,listindice **Listofindices) +{ + if ( Listofindices[var->v_catvar] ) + { + var->v_indicetabvars = Listofindices[var->v_catvar] -> i_indice; + if ( Listofindices[var->v_catvar]->suiv ) + Listofindices[var->v_catvar] = Listofindices[var->v_catvar]->suiv; + else + Listofindices[var->v_catvar] = (listindice *)NULL; + } + else + { + indicemaxtabvars[var->v_catvar] = indicemaxtabvars[var->v_catvar] + 1 ; + var->v_indicetabvars = indicemaxtabvars[var->v_catvar]; + } + +} + +/******************************************************************************/ +/* IndiceTabvars_Common_Var_No_Treated */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +void IndiceTabvars_Common_Var_No_Treated(char *nom) +{ + listvar *parcours; + listvar *parcours2; + + if ( todebug == 1 ) printf("COMMON No Treated %s \n",nom); + + parcours = List_Common_Var; + while( parcours ) + { + if ( !strcasecmp(parcours->var->v_commonname,nom) && + strcasecmp(parcours->var->v_subroutinename,"") && + parcours->var->v_indicetabvars == 0 + ) + { + /* The type may has not been given if the variable was only declared with dimension */ + + if ( !strcasecmp(parcours->var->v_typevar,"") ) + { + if ( IsVariableReal(parcours->var->v_nomvar) == 1 ) + strcpy(parcours->var->v_typevar,"REAL"); + else strcpy(parcours->var->v_typevar,"INTEGER"); + parcours->var->v_catvar = get_cat_var(parcours->var); + } + + indicemaxtabvars[parcours->var->v_catvar] = indicemaxtabvars[parcours->var->v_catvar] + 1 ; + parcours->var->v_indicetabvars = indicemaxtabvars[parcours->var->v_catvar]; + parcours2 = parcours; + while ( parcours2 ) + { + if ( !strcasecmp(parcours->var->v_nomvar, + parcours2->var->v_nomvar) && + !strcasecmp(parcours->var->v_commonname, + parcours2->var->v_commonname) + ) + parcours2->var->v_indicetabvars = parcours->var->v_indicetabvars; + parcours2 = parcours2->suiv; + } + } + parcours = parcours->suiv; + } +} + + +/******************************************************************************/ +/* IndiceTabvarsIdentification */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +void IndiceTabvarsIdentification() +{ + listnom *parcours_nom; + + /* Identification of tabvars indices in List_Global_Var */ + parcours_nom = List_NameOfModule; + while ( parcours_nom ) + { + if ( is_dependfile_created(parcours_nom->o_nom) == 1 ) + { + IndiceTabvars_Global_Var_Treated(parcours_nom->o_nom); + } + else + { + IndiceTabvars_Global_Var_No_Treated(parcours_nom->o_nom); + } + parcours_nom = parcours_nom -> suiv; + } + /* Identification of tabvars indices in List_Common_Var */ + parcours_nom = List_NameOfCommon; + while ( parcours_nom ) + { + if ( is_dependfile_created(parcours_nom->o_nom) == 1 ) + { + IndiceTabvars_Common_Var_Treated(parcours_nom->o_nom); + } + else + { + IndiceTabvars_Common_Var_No_Treated(parcours_nom->o_nom); + } + parcours_nom = parcours_nom -> suiv; + } + +} + +void New_Allocate_Subroutine_Is_Necessary() +{ + listnom *parcours_nom; + listvar *parcours; + int out; + + parcours_nom = List_NameOfModule; + while ( parcours_nom ) + { + /* */ + parcours = List_Global_Var; + out = 0 ; + while( parcours && out == 0 ) + { + if ( !strcasecmp(parcours->var->v_modulename,parcours_nom->o_nom) && + !strcasecmp(parcours->var->v_subroutinename,"") && + parcours->var->v_VariableIsParameter == 0 && + ( parcours->var->v_allocatable == 0 || !strcasecmp(parcours->var->v_typevar,"type")) && + parcours->var->v_notgrid == 0 && + ( ( parcours->var->v_nbdim != 0 || !strcasecmp(parcours->var->v_typevar,"type") ) + || parcours->var->v_initialvalue ) + ) + { + out = 1; + } + else parcours = parcours -> suiv; + } + if ( out ) + { + parcours_nom->o_val = 1 ; + } + parcours_nom = parcours_nom -> suiv; + } +} + +void New_Allocate_Subroutine_For_Common_Is_Necessary() +{ + listnom *parcours_nom; + listvar *parcours; + int out; + + parcours_nom = List_NameOfCommon; + while ( parcours_nom ) + { + parcours = List_Common_Var; + out = 0 ; + while( parcours && out == 0 ) + { + if ( !strcasecmp(parcours->var->v_commonname,parcours_nom->o_nom) && + strcasecmp(parcours->var->v_subroutinename,"") && + !strcasecmp(parcours->var->v_commoninfile,cur_filename) && + ( ( parcours->var->v_nbdim != 0 || !strcasecmp(parcours->var->v_typevar,"type") ) + || parcours->var->v_initialvalue ) + ) + { + out = 1; + } + else parcours = parcours -> suiv; + } + if ( out == 1 ) + { + parcours_nom->o_val = 1 ; + } + parcours_nom = parcours_nom -> suiv; + } +} + +void NewModule_Creation_0() +{ + listnom *parcours_nom; + + parcours_nom = List_NameOfCommon; + while ( parcours_nom ) + { + if ( parcours_nom->o_val == 1 ) + { + fprintf(fortran_out, " module %s\n\n", parcours_nom->o_nom); + WriteUsemoduleDeclaration(parcours_nom->o_subroutinename); + fprintf(fortran_out, " implicit none\n"); + fprintf(fortran_out, " public :: Alloc_agrif_%s\n", parcours_nom->o_nom); + fprintf(fortran_out, " contains\n"); + fprintf(fortran_out, " subroutine Alloc_agrif_%s(Agrif_Gr)\n", parcours_nom->o_nom); + fprintf(fortran_out, " use Agrif_Util\n"); + fprintf(fortran_out, " type(Agrif_grid), pointer :: Agrif_Gr\n"); + fprintf(fortran_out, " integer :: i\n"); + fprintf(fortran_out, "#include \"alloc_agrif_%s.h\"\n", parcours_nom->o_nom); + fprintf(fortran_out, " end subroutine Alloc_agrif_%s\n", parcours_nom->o_nom); + fprintf(fortran_out, " end module %s\n", parcours_nom->o_nom); + /* List all Call Alloc_agrif */ + Add_Subroutine_For_Alloc(parcours_nom->o_nom); + } + parcours_nom = parcours_nom->suiv; + } +} + +void UpdateList_SubroutineWhereAgrifUsed() +{ + listnom *parcours; + listusemodule *parcours1; + listallocate *parcours2; + listname *parcours3; + listvar *parcours4; + int out; + char name_module[LONG_M]; + + /* We should integrate allocate and pointer variables */ +// parcours2 = List_Allocate_Var; +// while ( parcours2 ) +// { +// parcours4 = List_UsedInSubroutine_Var; +// out = 0 ; +// while ( parcours4 && out == 0 ) +// { +// if ( !strcasecmp(parcours2->a_nomvar,parcours4->var->v_nomvar) ) +// { +// Add_SubroutineWhereAgrifUsed_1(parcours4->var->v_subroutinename, parcours4->var->v_modulename); +// out = 1; +// } +// else parcours4 = parcours4 -> suiv ; +// } +// parcours2 = parcours2->suiv; +// } +// +// parcours3 = List_Pointer_Var; +// while ( parcours3 ) +// { +// parcours4 = List_UsedInSubroutine_Var; +// out = 0 ; +// while ( parcours4 && out == 0 ) +// { +// if ( !strcasecmp(parcours3->n_name, parcours4->var->v_nomvar) ) +// { +// Add_SubroutineWhereAgrifUsed_1(parcours4->var->v_subroutinename, parcours4->var->v_modulename); +// out = 1; +// } +// else parcours4 = parcours4 -> suiv ; +// } +// parcours3 = parcours3 -> suiv; +// } +// parcours4 = List_UsedInSubroutine_Var; +// while ( parcours4 ) +// { +// if ( parcours4->var->v_allocatable == 1 && strcasecmp(parcours4->var->v_typevar,"type")) +// { +// Add_SubroutineWhereAgrifUsed_1(parcours4->var->v_subroutinename, parcours4->var->v_modulename); +// } +// parcours4 = parcours4 -> suiv ; +// } + + parcours = List_SubroutineWhereAgrifUsed; + while ( parcours ) + { + parcours1 = List_NameOfModuleUsed; + out = 0 ; + strcpy(name_module,""); + while ( parcours1 && out == 0 ) + { + if ( !strcasecmp(parcours->o_nom,parcours1->u_cursubroutine) && + !strcasecmp(parcours1->u_usemodule,"Agrif_Util") + ) out = 1; + else + { + if ( !strcasecmp(parcours->o_nom,parcours1->u_cursubroutine) ) + { + strcpy(name_module, parcours->o_module); + } + parcours1 = parcours1->suiv; + } + } + if ( out == 0 ) /* we should look in the module declaration */ + { + parcours1 = List_NameOfModuleUsed; + out = 0 ; + while ( parcours1 && out == 0 ) + { + if ( !strcasecmp(name_module,parcours1->u_modulename) && + !strcasecmp(parcours1->u_cursubroutine,"")&& + !strcasecmp(parcours1->u_usemodule,"Agrif_Util") + ) out = 1; + else parcours1 = parcours1->suiv; + } + } + if ( out == 0 ) parcours->o_val = 1; + + parcours = parcours->suiv; + } +} + + +void UpdateList_UsedInSubroutine_With_dimension() +{ + listvar *parcours; + + parcours = List_UsedInSubroutine_Var; + while ( parcours ) + { + if ( parcours->var->v_nbdim != 0 ) + { + strcpy(subroutinename,parcours->var->v_subroutinename); + DecomposeTheName(parcours->var->v_readedlistdimension); + strcpy(subroutinename,""); + } + parcours = parcours -> suiv; + } +} + +void Affiche(listvar *in_parcours) +{ +/* parcours = List_Global_Var; */ +/* parcours = List_SubroutineDeclaration_Var; */ +/* parcours = List_SubroutineArgument_Var; */ +/* parcours = List_FunctionType_Var; */ +/* parcours = List_Data_Var; */ +/* parcours = List_Save_Var; */ +/* parcours = List_UsedInSubroutine_Var; */ +/* parcours = List_Parameter_Var; */ +/* parcours = List_GlobalParameter_Var; */ +/* parcours = List_NotGridDepend_Var; */ +/* parcours = List_Common_Var; */ + listvar *parcours = in_parcours; + + while( parcours ) + { + printf("modulename - %s \n", parcours->var->v_modulename); + printf("subroutinename - %s \n", parcours->var->v_subroutinename); + printf("nomvar - %s \n", parcours->var->v_nomvar); + printf("commonname - %s \n", parcours->var->v_commonname); + printf("commoninfile - %s \n", parcours->var->v_commoninfile); + printf("typevar - %s \n", parcours->var->v_typevar); + printf("catvar - %d \n", parcours->var->v_catvar); + printf("indicetabvars - %d \n", parcours->var->v_indicetabvars); + printf("isparameter - %d \n", parcours->var->v_VariableIsParameter); + printf("module - %d \n", parcours->var->v_module); + printf("save - %d \n", parcours->var->v_save); + printf("notgrid - %d \n", parcours->var->v_notgrid); + printf("nbdim - %d \n", parcours->var->v_nbdim); + printf("common - %d \n", parcours->var->v_common); + printf("dimensiongiven - %d \n", parcours->var->v_dimensiongiven); + printf("dimsempty - %d \n", parcours->var->v_dimsempty); + printf("initialvalue - %s \n", parcours->var->v_initialvalue->n_name); + printf("readedlistdim - %s \n", parcours->var->v_readedlistdimension); + printf("-------------------------------------\n"); + + parcours = parcours -> suiv ; + } + if ( todebug == 1 ) printf("Indicemaxtabvars = %d \n",indicemaxtabvars[0]); +} + +int SubInList_ContainsSubroutine() +{ + int out; + listnom *parcours; + + out = 0 ; + parcours = List_ContainsSubroutine; + while ( parcours && out == 0 ) + { + if ( !strcasecmp(parcours->o_nom,subroutinename) ) out = 1 ; + else parcours = parcours -> suiv; + } + + return out; +} diff --git a/CROCO/croco-v1.3.1/AGRIF/LIB/WorkWithvarofsubroutineliste.c b/CROCO/croco-v1.3.1/AGRIF/LIB/WorkWithvarofsubroutineliste.c new file mode 100644 index 00000000..257f1c98 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/LIB/WorkWithvarofsubroutineliste.c @@ -0,0 +1,78 @@ +/******************************************************************************/ +/* */ +/* CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran) */ +/* */ +/* Copyright or or Copr. Laurent Debreu (Laurent.Debreu@imag.fr) */ +/* Cyril Mazauric (Cyril_Mazauric@yahoo.fr) */ +/* This software is governed by the CeCILL-C license under French law and */ +/* abiding by the rules of distribution of free software. You can use, */ +/* modify and/ or redistribute the software under the terms of the CeCILL-C */ +/* license as circulated by CEA, CNRS and INRIA at the following URL */ +/* "http://www.cecill.info". */ +/* */ +/* As a counterpart to the access to the source code and rights to copy, */ +/* modify and redistribute granted by the license, users are provided only */ +/* with a limited warranty and the software's author, the holder of the */ +/* economic rights, and the successive licensors have only limited */ +/* liability. */ +/* */ +/* In this respect, the user's attention is drawn to the risks associated */ +/* with loading, using, modifying and/or developing or reproducing the */ +/* software by the user in light of its specific status of free software, */ +/* that may mean that it is complicated to manipulate, and that also */ +/* therefore means that it is reserved for developers and experienced */ +/* professionals having in-depth computer knowledge. Users are therefore */ +/* encouraged to load and test the software's suitability as regards their */ +/* requirements in conditions enabling the security of their systems and/or */ +/* data to be ensured and, more generally, to use and operate it in the */ +/* same conditions as regards security. */ +/* */ +/* The fact that you are presently reading this means that you have had */ +/* knowledge of the CeCILL-C license and that you accept its terms. */ +/******************************************************************************/ +/* version 1.7 */ +/******************************************************************************/ +#include +#include +#include +#include "decl.h" + +/******************************************************************************/ +/* Add_SubroutineArgument_Var_1 */ +/******************************************************************************/ +void Add_SubroutineArgument_Var_1(listvar *listtoadd) +{ + List_SubroutineArgument_Var = AddListvarToListvar(listtoadd, List_SubroutineArgument_Var, 1); +} + +/******************************************************************************/ +/* Add_FunctionType_Var_1 */ +/******************************************************************************/ +void Add_FunctionType_Var_1(const char *nom) +{ + listvar *newvar; + + curvar = createvar(nom, NULL); + strcpy(curvar->v_typevar, DeclType); + newvar = insertvar(NULL, curvar); + List_FunctionType_Var = AddListvarToListvar(newvar,List_FunctionType_Var,1); +} + +/******************************************************************************/ +/* Add_SubroutineDeclaration_Var_1 */ +/******************************************************************************/ +/* We should complete the listvarofsubroutine */ +/******************************************************************************/ +// void Add_SubroutineDeclaration_Var_1 (listvar *listtoadd) +// { +// if ( firstpass == 1 ) +// { +// if ( VariableIsParameter == 0 && +// SaveDeclare == 0 ) +// { +// listduplicated = (listvar *)NULL; +// duplicatelistvar(listtoadd); +// List_SubroutineDeclaration_Var = AddListvarToListvar(listduplicated,List_SubroutineDeclaration_Var,1); +// } +// } +// } diff --git a/CROCO/croco-v1.3.1/AGRIF/LIB/WriteInFile.c b/CROCO/croco-v1.3.1/AGRIF/LIB/WriteInFile.c new file mode 100644 index 00000000..7543c295 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/LIB/WriteInFile.c @@ -0,0 +1,159 @@ +/******************************************************************************/ +/* */ +/* CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran) */ +/* */ +/* Copyright or or Copr. Laurent Debreu (Laurent.Debreu@imag.fr) */ +/* Cyril Mazauric (Cyril_Mazauric@yahoo.fr) */ +/* This software is governed by the CeCILL-C license under French law and */ +/* abiding by the rules of distribution of free software. You can use, */ +/* modify and/ or redistribute the software under the terms of the CeCILL-C */ +/* license as circulated by CEA, CNRS and INRIA at the following URL */ +/* "http://www.cecill.info". */ +/* */ +/* As a counterpart to the access to the source code and rights to copy, */ +/* modify and redistribute granted by the license, users are provided only */ +/* with a limited warranty and the software's author, the holder of the */ +/* economic rights, and the successive licensors have only limited */ +/* liability. */ +/* */ +/* In this respect, the user's attention is drawn to the risks associated */ +/* with loading, using, modifying and/or developing or reproducing the */ +/* software by the user in light of its specific status of free software, */ +/* that may mean that it is complicated to manipulate, and that also */ +/* therefore means that it is reserved for developers and experienced */ +/* professionals having in-depth computer knowledge. Users are therefore */ +/* encouraged to load and test the software's suitability as regards their */ +/* requirements in conditions enabling the security of their systems and/or */ +/* data to be ensured and, more generally, to use and operate it in the */ +/* same conditions as regards security. */ +/* */ +/* The fact that you are presently reading this means that you have had */ +/* knowledge of the CeCILL-C license and that you accept its terms. */ +/******************************************************************************/ +/* version 1.7 */ +/******************************************************************************/ +#include +#include +#include +#include "decl.h" + +/******************************************************************************/ +/* tofich_reste */ +/******************************************************************************/ +/* This subroutine is used to write the string s into the fileout */ +/******************************************************************************/ +void tofich_reste (FILE * filout, const char *s, int do_returnline) +{ + const size_t line_length = 66; + char temp[line_length+1]; + size_t s_length; + + s_length = strlen(s); + + if ( !strcmp(&s[strlen(s)-1], "\n") ) + s_length = strlen(s)-1; + + if ( s_length <= line_length ) + { + if ( do_returnline ) fprintf(filout, " &%s\n", s); + else fprintf(filout, "&%s", s); + } + else + { + strncpy(temp, s, line_length); + temp[line_length] = '\0'; + if ( retour77 == 0 && (s_length-strlen(temp) > 0) ) + fprintf(filout, " &%s&\n", temp); + else fprintf(filout, " &%s\n", temp); + + if ( s_length-strlen(temp) > 0 ) + tofich_reste(filout, (char *) &s[line_length], do_returnline); + } +} + +/******************************************************************************/ +/* tofich */ +/******************************************************************************/ +/* This subroutine is used to write the string s into the fileout */ +/******************************************************************************/ +void tofich (FILE * filout, const char *s, int do_returnline) +{ + const size_t line_length = 66; + char temp[line_length+1]; + size_t s_length; + + s_length = strlen(s); + + if ( !strcmp(&s[strlen(s)-1], "\n") ) + s_length = strlen(s)-1; + + if ( s_length <= line_length ) + { + if ( do_returnline ) fprintf(filout, " %s\n", s); + else fprintf(filout, "%s", s); + } + else + { + strncpy(temp, s, line_length); + temp[line_length] = '\0'; + + if ( retour77 == 0 ) fprintf(filout, " %s&\n", temp); + else fprintf(filout, " %s\n", temp); + + tofich_reste(filout, (char *) &s[line_length], do_returnline); + } +} + +/******************************************************************************/ +/* tofich_blanc */ +/******************************************************************************/ +/* This subroutine is used to write size blank into the fileout */ +/******************************************************************************/ +void tofich_blanc (FILE * filout, int size) +{ + const char* empty_char = " "; + int i = 0; + + if (size <= 65) + fprintf(filout, "%*s\n", size, empty_char); + else + { + do + { + fprintf(filout, "%*s\n", 65, empty_char); + i++; + } + while ( i <= size / 65 ); + + fprintf(filout, "%*s\n", size%65, empty_char); + } +} + +/******************************************************************************/ +/* RemoveWordSET_0 */ +/******************************************************************************/ +/* This subroutine is used to remove a sentence in the file filout */ +/******************************************************************************/ +void RemoveWordSET_0(FILE * filout, long int position, int sizetoremove) +{ + if ( inside_type_declare || firstpass ) return; + + fseek(filout, position, SEEK_SET); + tofich_blanc(filout, sizetoremove); + +} + +/******************************************************************************/ +/* RemoveWordCUR_0 */ +/******************************************************************************/ +/* This subroutine is used to remove a sentence in the file filout */ +/******************************************************************************/ +void RemoveWordCUR_0(FILE * filout, int sizetoremove) +{ + if ( inside_type_declare || firstpass ) return; + + fseek(filout, (long int)(-sizetoremove), SEEK_CUR); + tofich_blanc(filout, sizetoremove); + fseek(filout, (long int)(-sizetoremove), SEEK_CUR); + if ( strstr(fortran_text, "\n") ) fprintf(filout, "\n"); +} diff --git a/CROCO/croco-v1.3.1/AGRIF/LIB/Writedeclarations.c b/CROCO/croco-v1.3.1/AGRIF/LIB/Writedeclarations.c new file mode 100644 index 00000000..df016ba4 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/LIB/Writedeclarations.c @@ -0,0 +1,746 @@ +/******************************************************************************/ +/* */ +/* CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran) */ +/* */ +/* Copyright or or Copr. Laurent Debreu (Laurent.Debreu@imag.fr) */ +/* Cyril Mazauric (Cyril_Mazauric@yahoo.fr) */ +/* This software is governed by the CeCILL-C license under French law and */ +/* abiding by the rules of distribution of free software. You can use, */ +/* modify and/ or redistribute the software under the terms of the CeCILL-C */ +/* license as circulated by CEA, CNRS and INRIA at the following URL */ +/* "http://www.cecill.info". */ +/* */ +/* As a counterpart to the access to the source code and rights to copy, */ +/* modify and redistribute granted by the license, users are provided only */ +/* with a limited warranty and the software's author, the holder of the */ +/* economic rights, and the successive licensors have only limited */ +/* liability. */ +/* */ +/* In this respect, the user's attention is drawn to the risks associated */ +/* with loading, using, modifying and/or developing or reproducing the */ +/* software by the user in light of its specific status of free software, */ +/* that may mean that it is complicated to manipulate, and that also */ +/* therefore means that it is reserved for developers and experienced */ +/* professionals having in-depth computer knowledge. Users are therefore */ +/* encouraged to load and test the software's suitability as regards their */ +/* requirements in conditions enabling the security of their systems and/or */ +/* data to be ensured and, more generally, to use and operate it in the */ +/* same conditions as regards security. */ +/* */ +/* The fact that you are presently reading this means that you have had */ +/* knowledge of the CeCILL-C license and that you accept its terms. */ +/******************************************************************************/ +/* version 1.7 */ +/******************************************************************************/ +#include +#include +#include + +#include "decl.h" + +/******************************************************************************/ +/* WriteBeginDeclaration */ +/******************************************************************************/ +/* This subroutine is used to write the begin of a declaration */ +/* taken in a variable record */ +/* */ +/******************************************************************************/ +/* */ +/* integer variable -----------> INTEGER */ +/* */ +/******************************************************************************/ +void WriteBeginDeclaration(variable *v, char line[LONG_M], int visibility) +{ + char tmpligne[LONG_M]; + int precision_given ; + + if ( !strcasecmp(v->v_typevar,"") ) + { + printf("# WARNING : The type of the variable %s is unknown.\n", v->v_nomvar); + printf("# CONV should define a type\n"); + } + + sprintf(line, "%s", v->v_typevar); + if ( v->v_c_star == 1 ) strcat(line, "*"); + + /* We should give the precision of the variable if it has been given */ + precision_given = 0; + + if ( strcasecmp(v->v_precision,"") ) + { + sprintf(tmpligne, "(%s)", v->v_precision); + Save_Length(tmpligne, 49); + strcat(line, tmpligne); + precision_given = 1; + } + + if (strcasecmp(v->v_dimchar,"")) + { + sprintf(tmpligne,"(%s)",v->v_dimchar); + Save_Length(tmpligne, 49); + strcat(line,tmpligne); + } + + if ((precision_given == 0) && ( strcasecmp(v->v_nameinttypename,"") )) + { + sprintf(tmpligne,"*%s",v->v_nameinttypename); + Save_Length(tmpligne, 49); + strcat(line,tmpligne); + } + if (strcasecmp (v->v_IntentSpec, "")) + { + sprintf(tmpligne,", intent(%s)", v->v_IntentSpec); + Save_Length(tmpligne, 49); + strcat(line,tmpligne); + } + if ( v->v_VariableIsParameter ) strcat(line, ", parameter"); + if ( visibility ) + { + if ( v->v_PublicDeclare ) strcat(line, ", public"); + if ( v->v_PrivateDeclare ) strcat(line, ", private"); + } + if ( v->v_ExternalDeclare ) strcat(line, ", external"); + if ( v->v_allocatable ) strcat(line, ", allocatable"); + if ( v->v_target ) strcat(line, ", target"); + if ( v->v_optionaldeclare ) strcat(line, ", optional"); + if ( v->v_pointerdeclare ) strcat(line, ", pointer"); + Save_Length(line, 45); +} + + +/******************************************************************************/ +/* WriteScalarDeclaration */ +/******************************************************************************/ +/* This subroutine is used to write a scalar declaration */ +/* taken in a variable record */ +/* */ +/******************************************************************************/ +/* */ +/* integer variable -----------> INTEGER :: VARIABLE */ +/* */ +/******************************************************************************/ +void WriteScalarDeclaration( variable *v, char line[LONG_M]) +{ + strcat(line, " :: "); + strcat(line, v->v_nomvar); + + if ( strcasecmp(v->v_vallengspec, "") ) strcat(line,v->v_vallengspec); + if ( v->v_VariableIsParameter ) + { + strcat(line," = "); + strcat(line, v->v_initialvalue->n_name); + } + Save_Length(line, 45); +} + +/******************************************************************************/ +/* WriteTableDeclaration */ +/******************************************************************************/ +/* This subroutine is used to write a Table declaration */ +/* taken in a variable record */ +/* */ +/******************************************************************************/ +/* */ +/* integer variable(nb) -----------> */ +/* INTEGER, DIMENSION(1:nb) :: variable */ +/* */ +/******************************************************************************/ +void WriteTableDeclaration(variable * v,char ligne[LONG_M],int tmpok) +{ + char newname[LONG_M]; + + strcat (ligne, ", dimension("); + + if ( v->v_dimensiongiven == 1 && tmpok == 1 ) strcat(ligne,v->v_readedlistdimension); + if ( v->v_dimensiongiven == 1 && tmpok == 0 ) + { + strcpy(newname,ChangeTheInitalvaluebyTabvarsName(v->v_readedlistdimension,List_Global_Var)); + if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension); + + strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname,List_Common_Var)); + if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension); + + strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname,List_ModuleUsed_Var)); + if ( !strcasecmp(newname,"") ) strcat(newname,v->v_readedlistdimension); + + Save_Length(newname,47); + strcat(ligne,newname); + } + strcat(ligne, ") :: "); + strcat(ligne, v->v_nomvar); + if ( strcasecmp(vallengspec,"") ) strcat(ligne,v->v_vallengspec); + + if ( v->v_VariableIsParameter == 1 ) + { + strcat(ligne," = "); + strcat(ligne,v->v_initialvalue->n_name); + } + Save_Length(ligne,45); +} + +/******************************************************************************/ +/* WriteVarDeclaration */ +/******************************************************************************/ +/* This subroutine is used to write the initial declaration in the file */ +/* fileout of a variable */ +/* */ +/******************************************************************************/ +/* */ +/* integer variable(nb) -----------> */ +/* INTEGER, DIMENSION(1:nb),Pointer :: variable */ +/* */ +/******************************************************************************/ +void WriteVarDeclaration( variable *v, FILE *fileout, int value, int visibility ) +{ + FILE *filecommon; + char ligne[LONG_M]; + + filecommon = fileout; + + if ( v->v_save == 0 || inmodulemeet == 0 ) + { + WriteBeginDeclaration(v, ligne, visibility); + + if ( v->v_nbdim == 0 ) + WriteScalarDeclaration(v, ligne); + else + WriteTableDeclaration(v, ligne, value); + + if ( v->v_VariableIsParameter != 1 && v->v_initialvalue) + { + strcat(ligne," = "); + strcat(ligne,v->v_initialvalue->n_name); + } + tofich(filecommon, ligne, 1); + } + else + printf("-- in writevardeclaration : |%s| -- MHCHECK\n", v->v_nomvar); + Save_Length(ligne,45); +} + + +void WriteLocalParamDeclaration(FILE* tofile) +{ + listvar *parcours; + + parcours = List_Parameter_Var; + while ( parcours ) + { + if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) ) + { + WriteVarDeclaration(parcours->var, tofile, 0, 1); + } + parcours = parcours -> suiv; + } +} + +void WriteFunctionDeclaration(FILE* tofile, int value) +{ + listvar *parcours; + + parcours = List_FunctionType_Var; + while ( parcours ) + { + if (!strcmp(parcours->var->v_typevar, "")) + { + /* Default type*/ + if ( IsVariableReal(parcours->var->v_nomvar) == 1 ) + strcpy(parcours->var->v_typevar,"REAL"); + else strcpy(parcours->var->v_typevar,"INTEGER"); + } + if ( !strcasecmp(parcours->var->v_subroutinename, subroutinename) && + strcasecmp(parcours->var->v_typevar, "") ) + { + WriteVarDeclaration(parcours->var, tofile, value, 1); + } + parcours = parcours -> suiv; + } +} + +void WriteSubroutineDeclaration(int value) +{ + listvar *parcours; + variable *v; + + parcours = List_SubroutineDeclaration_Var; + while ( parcours ) + { + v = parcours->var; + if ( !strcasecmp(v->v_subroutinename, subroutinename) && + (v->v_save == 0) && + (v->v_VariableIsParameter == 0) && + (v->v_common == 0) ) + { + WriteVarDeclaration(v, fortran_out, value, 1); + } + else if ( !strcasecmp(v->v_subroutinename, subroutinename) && + (v->v_save == 0) && + (v->v_VariableIsParameter == 0) && + (v->v_common == 0) ) + { + WriteVarDeclaration(v, fortran_out, value, 1); + } + parcours = parcours -> suiv; + } +} + +void WriteArgumentDeclaration_beforecall() +{ + int position; + listnom *neededparameter; + FILE *paramtoamr; + listvar *parcours; + variable *v; + char *ligne; + size_t line_length; + int res; + int global_check; + + ligne = (char*) calloc(LONG_M, sizeof(char)); + line_length = LONG_M; + + global_check = 0; + + + fprintf(fortran_out,"#include \"Param_BeforeCall_%s.h\"\n",subroutinename); + + sprintf(ligne,"Param_BeforeCall_%s.h",subroutinename); + paramtoamr = open_for_write(ligne); + + neededparameter = (listnom * )NULL; + position = 1; + parcours = List_SubroutineArgument_Var; + + while ( parcours ) + { + v = parcours->var; + if ( !strcasecmp(v->v_subroutinename, subroutinename) && (v->v_positioninblock == position) ) + { + position++; + WriteVarDeclaration(v, fortran_out, 0, 1); + res = writedeclarationintoamr(List_Parameter_Var, paramtoamr, + v, v->v_subroutinename, &neededparameter, subroutinename, global_check); + parcours = List_SubroutineArgument_Var; + } + else parcours = parcours -> suiv; + } + + // Write interface for 'Sub_Loop_machin' in 'Param_BeforeCall_machin.h' when outside a module + if ( IsTabvarsUseInArgument_0() && (inmodulemeet == 0) && (inprogramdeclare == 0) ) + { + fprintf(paramtoamr, " interface\n"); + if (isrecursive) sprintf(ligne," recursive subroutine Sub_Loop_%s(", subroutinename); + else sprintf(ligne," subroutine Sub_Loop_%s(", subroutinename); + WriteVariablelist_subloop(&ligne,&line_length); + WriteVariablelist_subloop_Def(&ligne,&line_length); + strcat(ligne,")"); + + tofich(paramtoamr,ligne,1); + + listusemodule *parcours_mod; + parcours_mod = List_NameOfModuleUsed; + while ( parcours_mod ) + { + if ( !strcasecmp(parcours_mod->u_cursubroutine, subroutinename) ) + { + fprintf(paramtoamr, " use %s\n", parcours_mod->u_usemodule); + } + parcours_mod = parcours_mod->suiv; + } + fprintf(paramtoamr, " implicit none\n"); + WriteLocalParamDeclaration(paramtoamr); + writesub_loopdeclaration_scalar(List_UsedInSubroutine_Var, paramtoamr); + writesub_loopdeclaration_tab(List_UsedInSubroutine_Var, paramtoamr); + WriteArgumentDeclaration_Sort(paramtoamr); + WriteFunctionDeclaration(paramtoamr, 1); + + sprintf(ligne," end subroutine Sub_Loop_%s\n", subroutinename); + tofich(paramtoamr, ligne, 1); + fprintf(paramtoamr, " end interface\n"); + } + fclose(paramtoamr); +} + +void WriteArgumentDeclaration_Sort(FILE* tofile) +{ + int position = 1; + listvar *parcours; + + parcours = List_SubroutineArgument_Var; + + while ( parcours ) + { + if ( !strcasecmp(parcours->var->v_subroutinename, subroutinename) && + parcours->var->v_positioninblock == position ) + { + position = position + 1; + WriteVarDeclaration(parcours->var, tofile, 1, 1); + parcours = List_SubroutineArgument_Var; + } + else parcours = parcours -> suiv; + } + + parcours = List_SubroutineArgument_Var; + while ( parcours ) + { + if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) && + parcours->var->v_positioninblock == 0 && + parcours->var->v_nbdim == 0 ) + { + WriteVarDeclaration(parcours->var,tofile,1,1); + } + parcours = parcours -> suiv; + } + + parcours = List_SubroutineArgument_Var; + while ( parcours ) + { + if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) && + parcours->var->v_positioninblock == 0 && + parcours->var->v_nbdim != 0 ) + { + WriteVarDeclaration(parcours->var, tofile, 1, 1); + } + parcours = parcours -> suiv; + } +} + +/******************************************************************************/ +/* writedeclarationintoamr */ +/******************************************************************************/ +/* This subroutine is used to write the declaration of parameters needed in */ +/* allocation subroutines creates in toamr.c */ +/******************************************************************************/ +/* */ +/* */ +/******************************************************************************/ +int writedeclarationintoamr (listvar * deb_common, FILE *fileout, + variable *var , const char *commonname, + listnom **neededparameter, const char *name_common, int global_check) +{ + listvar *newvar; + variable *v; + char ligne[LONG_M]; + int changeval; + int out; + int writeit; + listnom *parcours; + listname *parcours_name_array; + int res; + + res = 0; + + /* we should list the needed parameter */ + + if ( !strcasecmp(name_common,commonname) ) + { + *neededparameter = DecomposeTheNameinlistnom(var->v_readedlistdimension,*neededparameter); + parcours_name_array = var->v_initialvalue_array; + while (parcours_name_array) + { + *neededparameter = DecomposeTheNameinlistnom(parcours_name_array->n_name,*neededparameter); + parcours_name_array=parcours_name_array->suiv; + } + } + + /* */ + parcours = *neededparameter; + + while (parcours) + { + newvar = deb_common; + + out = 0 ; + while ( newvar && out == 0 ) + { + if ( (global_check == 0) && !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) && !strcasecmp(var->v_subroutinename,newvar->var->v_subroutinename)) + { + out=1; + /* add the name to the list of needed parameter */ + *neededparameter = DecomposeTheNameinlistnom( + newvar->var->v_initialvalue->n_name, + *neededparameter ); + } + else if ( (global_check == 1) && !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) && !strcasecmp(var->v_modulename,newvar->var->v_modulename)) + { + out=1; + /* add the name to the list of needed parameter */ + *neededparameter = DecomposeTheNameinlistnom( + newvar->var->v_initialvalue->n_name, + *neededparameter ); + } + else newvar=newvar->suiv; + } + parcours=parcours->suiv; + } + /* */ + parcours = *neededparameter; + + while (parcours) + { + newvar = deb_common; + out = 0 ; + while ( newvar && out == 0 ) + { + if ( (global_check == 0) && !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) && !strcasecmp(var->v_subroutinename,newvar->var->v_subroutinename)) + { + out=1; + /* add the name to the list of needed parameter */ + *neededparameter = DecomposeTheNameinlistnom( + newvar->var->v_initialvalue->n_name, + *neededparameter ); + } + else if ( (global_check == 1) && !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) && !strcasecmp(var->v_modulename,newvar->var->v_modulename)) + { + out=1; + /* add the name to the list of needed parameter */ + *neededparameter = DecomposeTheNameinlistnom( + newvar->var->v_initialvalue->n_name, + *neededparameter ); + } + else newvar=newvar->suiv; + } + parcours=parcours->suiv; + } + parcours = *neededparameter; + while (parcours) + { + writeit = 0; + newvar = deb_common; + while ( newvar && writeit == 0 ) + { + if ( (global_check == 0) && !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) && + !strcasecmp(var->v_subroutinename,newvar->var->v_subroutinename) && parcours->o_val == 0 ) + { + writeit=1; + parcours->o_val = 1; + } + else if ( (global_check == 1) && !strcasecmp(parcours->o_nom,newvar->var->v_nomvar) && + !strcasecmp(var->v_modulename,newvar->var->v_modulename) && parcours->o_val == 0 ) + { + writeit=1; + parcours->o_val = 1; + } + else newvar = newvar->suiv; + } + + if ( writeit == 1 ) + { + changeval = 0; + v = newvar->var; +// if ( v->v_allocatable == 1 && strcasecmp(v->v_typevar,"type") ) +// { +// changeval = 1; +// v->v_allocatable = 0; +// } + WriteBeginDeclaration(v, ligne, 1); + if ( v->v_nbdim == 0 ) WriteScalarDeclaration(v,ligne); + else WriteTableDeclaration(v, ligne, 1); + + tofich(fileout, ligne, 1); + if ( changeval == 1 ) + { + v->v_allocatable = 1; + } + res = 1; + } + else + { + if ( strncasecmp(parcours->o_nom,"mpi_",4) == 0 && + shouldincludempif == 1 ) + { + shouldincludempif = 0; + fprintf(fileout," include \'mpif.h\'\n"); + } + } + parcours=parcours->suiv; + } + Save_Length(ligne,45); + return res; +} + + +/******************************************************************************/ +/* writesub_loopdeclaration_scalar */ +/******************************************************************************/ +/* This subroutine is used to write the declaration part of subloop */ +/* subroutines */ +/******************************************************************************/ +/* */ +/* integer variable(nb) -----------> */ +/* */ +/* INTEGER, DIMENSION(1:nb) :: variable */ +/* */ +/******************************************************************************/ +void writesub_loopdeclaration_scalar (listvar * deb_common, FILE *fileout) +{ + listvar *newvar; + variable *v; + char ligne[LONG_M]; + +// tofich (fileout, "",1); + newvar = deb_common; + + while (newvar) + { + if ( newvar->var->v_nbdim == 0 && + !strcasecmp(newvar->var->v_subroutinename,subroutinename) && + (newvar->var->v_pointerdeclare >= 0 || !strcasecmp(newvar->var->v_typevar,"type")) ) + { + v = newvar->var; + WriteBeginDeclaration(v,ligne,1); + WriteScalarDeclaration(v,ligne); + tofich (fileout, ligne,1); + } + newvar = newvar->suiv; + } + Save_Length(ligne,45); +} + +/******************************************************************************/ +/* writesub_loopdeclaration_tab */ +/******************************************************************************/ +/* This subroutine is used to write the declaration part of subloop */ +/* subroutines */ +/******************************************************************************/ +/* */ +/* integer variable(nb) -----------> */ +/* */ +/* INTEGER, DIMENSION(1:nb) :: variable */ +/* */ +/******************************************************************************/ +void writesub_loopdeclaration_tab (listvar * deb_common, FILE *fileout) +{ + listvar *newvar; + variable *v; + char ligne[LONG_M]; + int changeval; + + newvar = deb_common; + while (newvar) + { + v = newvar->var; +// printf("newvar = %s %d %s\n",newvar->var->v_nomvar,newvar->var->v_pointerdeclare,newvar->var->v_typevar); + if ( (v->v_nbdim != 0) && !strcasecmp(v->v_subroutinename, subroutinename) && + (v->v_pointerdeclare >= 0 || !strcasecmp(v->v_typevar,"type")) ) + { + changeval = 0; + if ( v->v_allocatable == 1) + { + if (strcasecmp(v->v_typevar,"type")) + { + // changeval = 1; + // v->v_allocatable = 0; + } + else + { + changeval = 2; + v->v_allocatable = 0; + v->v_pointerdeclare = 1; + } + } + + WriteBeginDeclaration(v, ligne, 1); + WriteTableDeclaration(v, ligne, 1); + tofich (fileout, ligne,1); + if ( changeval >= 1 ) v->v_allocatable = 1; + if ( changeval == 2 ) v->v_pointerdeclare = 0; + } + newvar = newvar->suiv; + } + + Save_Length(ligne,45); +} + +void ReWriteDeclarationAndAddTosubroutine_01(listvar *listdecl) +{ + listvar *parcours; + variable *v; + int out; + + if ( insubroutinedeclare ) + { + parcours = listdecl; + while ( parcours ) + { + v = parcours->var; + out = LookingForVariableInList(List_SubroutineArgument_Var, v); + if (out == 0) out = VariableIsInListCommon(parcours, List_Common_Var); + if (out == 0) out = LookingForVariableInList(List_Parameter_Var, v); + if (out == 0) out = LookingForVariableInList(List_FunctionType_Var, v); + if (out == 0) out = LookingForVariableInListGlobal(List_Global_Var, v); + + if (firstpass == 0 && out == 0 && VariableIsParameter == 0 && SaveDeclare == 0) + { + + /* The type may has not been given if the variable was only declared with dimension */ + + if ( !strcasecmp(v->v_typevar,"") ) + { + if ( IsVariableReal(v->v_nomvar) == 1 ) + strcpy(v->v_typevar,"REAL"); + else strcpy(v->v_typevar,"INTEGER"); + v->v_catvar = get_cat_var(v); + } + + WriteVarDeclaration(v, fortran_out, 1, 1); + } + if (firstpass == 1) + { + if (VariableIsParameter == 0 && SaveDeclare == 0) + { + List_SubroutineDeclaration_Var = insertvar(List_SubroutineDeclaration_Var, v); + } + } + parcours = parcours->suiv; + } + } +} + +void ReWriteDataStatement_0(FILE * filout) +{ + listvar *parcours; + int out; + char ligne[LONG_M]; + char initialvalue[LONG_M]; + listname *parcours_name; + + if (insubroutinedeclare == 1) + { + parcours = List_Data_Var_Cur ; + while (parcours) + { + out = VariableIsInListCommon(parcours,List_Common_Var); + if (out) break; + + out = LookingForVariableInListGlobal(List_Global_Var,parcours->var); + if (out) break; + + strcpy(initialvalue,""); + parcours_name = parcours->var->v_initialvalue; + while (parcours_name) + { + if (strncasecmp(parcours_name->n_name,"(/",2)) + { + strcat(initialvalue,parcours_name->n_name); + if (parcours_name->suiv) + { + strcat(initialvalue,","); + } + } + else + { + printf("A TRAITER DANS REWRITEDATA STATEMETN "); + exit(1); + strncpy(initialvalue,&parcours_name->n_name[2],strlen(parcours_name->n_name)-4); + strcpy(&initialvalue[strlen(parcours_name->n_name)-4],"\0"); + } + parcours_name=parcours_name->suiv; + } + sprintf(ligne,"data %s/%s/",parcours->var->v_nomvar,initialvalue); + tofich(filout,ligne,1); + + parcours = parcours->suiv; + } + } +} diff --git a/CROCO/croco-v1.3.1/AGRIF/LIB/decl.h b/CROCO/croco-v1.3.1/AGRIF/LIB/decl.h new file mode 100644 index 00000000..6040d767 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/LIB/decl.h @@ -0,0 +1,687 @@ +/******************************************************************************/ +/* */ +/* CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran) */ +/* */ +/* Copyright or or Copr. Laurent Debreu (Laurent.Debreu@imag.fr) */ +/* Cyril Mazauric (Cyril_Mazauric@yahoo.fr) */ +/* This software is governed by the CeCILL-C license under French law and */ +/* abiding by the rules of distribution of free software. You can use, */ +/* modify and/ or redistribute the software under the terms of the CeCILL-C */ +/* license as circulated by CEA, CNRS and INRIA at the following URL */ +/* "http://www.cecill.info". */ +/* */ +/* As a counterpart to the access to the source code and rights to copy, */ +/* modify and redistribute granted by the license, users are provided only */ +/* with a limited warranty and the software's author, the holder of the */ +/* economic rights, and the successive licensors have only limited */ +/* liability. */ +/* */ +/* In this respect, the user's attention is drawn to the risks associated */ +/* with loading, using, modifying and/or developing or reproducing the */ +/* software by the user in light of its specific status of free software, */ +/* that may mean that it is complicated to manipulate, and that also */ +/* therefore means that it is reserved for developers and experienced */ +/* professionals having in-depth computer knowledge. Users are therefore */ +/* encouraged to load and test the software's suitability as regards their */ +/* requirements in conditions enabling the security of their systems and/or */ +/* data to be ensured and, more generally, to use and operate it in the */ +/* same conditions as regards security. */ +/* */ +/* The fact that you are presently reading this means that you have had */ +/* knowledge of the CeCILL-C license and that you accept its terms. */ +/******************************************************************************/ +/* version 1.7 */ +/******************************************************************************/ +#define LONG_VNAME 80 // Max length for a variable name +#define LONG_FNAME 1000 // Max length for a file name +#define LONG_C 200 +#define LONG_M 1500 + +#define NB_CAT_VARIABLES 5 + +/******************************************************************************/ +/*********** Declaration of structures used in conv ***************************/ +/******************************************************************************/ + +typedef struct +{ + char first[LONG_M]; + char last[LONG_M]; +} typedim ; /* fortran dimension as 'ndeb:nfin' */ + +typedef struct listdim +{ + typedim dim; + struct listdim *suiv; +} listdim; /* list of the dimensions of a variable */ + +typedef struct listname +{ + char n_name[LONG_M]; + struct listname* suiv; +} listname ; /* list of names */ + +typedef struct do_loop +{ + char do_variable[LONG_VNAME]; + char do_begin[LONG_VNAME]; + char do_end[LONG_VNAME]; + char do_step[LONG_VNAME]; +} do_loop ; + +typedef struct listdoloop +{ + do_loop *cur_do_loop; + struct listdoloop* suiv; +} listdoloop; + +typedef struct variable +{ + char v_typevar[LONG_VNAME]; + char v_nomvar[LONG_VNAME] ; + char v_oldname[LONG_VNAME] ; + char v_dimchar[LONG_VNAME]; + char v_modulename[LONG_VNAME]; + char v_commonname[LONG_VNAME]; + char v_vallengspec[LONG_VNAME]; + char v_nameinttypename[LONG_VNAME]; + char v_commoninfile[LONG_FNAME]; + char v_subroutinename[LONG_VNAME]; + listdoloop *v_do_loop; + char v_precision[LONG_C]; + listname *v_initialvalue; + listname *v_initialvalue_array; + char v_IntentSpec[LONG_M]; + char v_readedlistdimension[LONG_M]; + int v_nbdim; + int v_common; + int v_positioninblock; + int v_module; + int v_save; + int v_catvar; + int v_VariableIsParameter; + int v_PublicDeclare; + int v_PrivateDeclare; + int v_ExternalDeclare; + int v_pointedvar; + int v_notgrid; + int v_dimensiongiven; + int v_c_star; + int v_indicetabvars; + int v_pointerdeclare; + int v_optionaldeclare; + int v_allocatable; + int v_target; + int v_dimsempty; + listdim *v_dimension; +} variable ; /* type of a variable */ + /* v_typevar : type (integer, real, ...) */ + /* v_nomvar : name of the variable */ + /* v_dimension : list of dimensions of the variable*/ + /* v_nbdim: 1 if the variable is 1d, etc ... */ + /* precision : Name of the variable which */ + /* determine the precision. example : wp in the */ + /* case where REAL(wp) */ + +typedef struct listvar +{ + variable *var ; + struct listvar * suiv; +} listvar ; /* list of variables */ + + +typedef struct listusemodule +{ + char u_usemodule[LONG_VNAME]; + char u_charusemodule[LONG_VNAME]; + char u_cursubroutine[LONG_VNAME]; + char u_modulename[LONG_VNAME]; + int u_firstuse; + struct listusemodule * suiv; +} listusemodule; /* list of names */ + +typedef struct listparameter +{ + char p_name[LONG_M]; + char p_modulename[LONG_M]; + struct listparameter * suiv; +} listparameter ; /* list of names */ + +typedef struct listcouple +{ + char c_namevar[LONG_VNAME]; + char c_namepointedvar[LONG_VNAME]; + struct listcouple * suiv; +} listcouple; /* list of names */ + + +typedef struct listnom +{ + char o_nom[LONG_C]; + char o_module[LONG_VNAME]; + char o_subroutinename[LONG_M]; + int o_val; + listcouple *couple; + struct listnom * suiv; +} listnom; /* list of names */ + + +typedef struct listallocate +{ + char a_nomvar[LONG_C]; + char a_subroutine[LONG_VNAME]; + char a_module[LONG_VNAME]; + struct listallocate * suiv; +} listallocate ; + + +typedef struct listvarpointtovar +{ + char t_usemodule[LONG_VNAME]; + char t_cursubroutine[LONG_VNAME]; + listcouple *t_couple; + struct listvarpointtovar* suiv; +}listvarpointtovar ; /* list of names */ + + +typedef struct listindice +{ + int i_indice; + struct listindice * suiv; +} listindice; /* list of indiced */ + + variable *curvar; + + listvar *List_ModuleUsedInModuleUsed_Var; + listvar *List_ModuleUsed_Var; + listvar *listduplicated; + + listvar *List_GlobalParameter_Var; + listvar *List_Global_Var; + listvar *List_Data_Var; + listvar *List_Data_Var_Cur; + listvar *List_Save_Var; + listvar *List_SubroutineArgument_Var; + listvar *List_SubroutineDeclaration_Var; + listvar *List_UsedInSubroutine_Var; + listvar *List_Parameter_Var; + listvar *List_Dimension_Var; + listvar *List_FunctionType_Var; + listvar *List_NotGridDepend_Var; + listvar *List_Common_Var; + + + listname *List_Pointer_Var; + listname *List_ImplicitNoneSubroutine; + + listname *List_Do_labels; + /* A list that contains the do labels if any */ + + listusemodule *List_NameOfModuleUsed; + listusemodule *List_Include; + listusemodule *listofmoduletmp; + listusemodule *tmpuselocallist; + + listparameter *List_GlobParamModuleUsedInModuleUsed_Var; + listparameter *List_GlobParamModuleUsed_Var; + + listnom *List_ContainsSubroutine; + listnom *List_Subroutine_For_Alloc; + listnom *listofmodules; + listnom *listofkind; + listnom *List_NameOfModule; + listnom *List_NameOfCommon; + listnom *List_SubroutineWhereAgrifUsed; + + listallocate *List_Allocate_Var; + + listvarpointtovar *List_CouplePointed_Var; + /* variables which are pointed to an other one */ + + listindice *Listofavailableindices; + /* List of available indices in the tabvars table */ + listindice **Listofavailableindices_glob; + + listdim *curdim; + listdim *commondim; + +/******************************************************************************/ +/**************** *** COMMON Variables *** *********************************/ +/******************************************************************************/ + + int positioninblock; + char commonvar[LONG_VNAME]; + char commonblockname[LONG_VNAME]; + +/******************************************************************************/ +/**************** *** AGRIF Variables *** *********************************/ +/******************************************************************************/ + int inagrifcallargument; + int afterpercent; + int sameagrifargument; + int InAgrifParentDef; + char sameagrifname[LONG_VNAME]; +/******************************************************************************/ +/**************** *** VAR DEF Variables *** *******************************/ +/******************************************************************************/ + int indicemaxtabvars[NB_CAT_VARIABLES]; /* Number of variables in the model i.e. last */ + /* indice used in the tabvars table */ + int PublicDeclare; /* Variable has been declared as PUBLIC */ + int PrivateDeclare; /* Variable has been declared as PRIVATE */ + int ExternalDeclare; /* Variable has been declared as EXTERNAL */ + int InitialValueGiven; /* An initial value has been given */ + int Allocatabledeclare; + int Targetdeclare; + int SaveDeclare; + int functiondeclarationisdone; + int pointerdeclare; + int optionaldeclare; + int inside_type_declare; + int VariableIsParameter; + int dimsgiven; + int shouldincludempif; + int c_star; + char DeclType[LONG_VNAME]; + char nameinttypename[LONG_VNAME]; + char nameinttypenameback[LONG_VNAME]; + int GlobalDeclaration; + int GlobalDeclarationType; + char InitValue[LONG_M]; + char IntentSpec[LONG_M]; + char NamePrecision[LONG_C]; + char CharacterSize[LONG_VNAME]; + char vallengspec[LONG_VNAME]; + int isrecursive; + int is_result_present; + +/******************************************************************************/ +/**************** *** CONV Variables *** **********************************/ +/******************************************************************************/ + int dimprob ; /* dimension of the problem : 1 for 1D,2 for 2D, */ + /* 3 for 3D */ + int onlyfixedgrids; /* = 1 if onlyfixedgrids is true */ + int todebug; + int fixedgrids; /* = 1 if fixedgrids is true */ + char nbmaillesX[LONG_VNAME]; // number of cells in the x direction + char nbmaillesY[LONG_VNAME]; // number of cells in the y direction + char nbmaillesZ[LONG_VNAME]; // number of cells in the z direction + int IndicenbmaillesX; + int IndicenbmaillesY; + int IndicenbmaillesZ; + + int inmodulemeet; + int incalldeclare; + int aftercontainsdeclare; /* Signale si l'on vient d'un contains ou non */ + int retour77; + int callagrifinitgrids; + int callmpiinit; + int firstpass; + int pointedvar; + int NbMailleXDefined; + int agrif_parentcall; + int didvariableadded; + int SubloopScalar; /* = 1 we should put in argument of sub_loop */ + /* only */ + /* scalar and not table u(1,1,1) in place of u */ + int inprogramdeclare; + int insubroutinedeclare; + int inmoduledeclare; + int dimsempty; + int created_dimensionlist; + int incontainssubroutine; + + char meetagrifinitgrids[LONG_M]; + char mpiinitvar[LONG_M]; + char toprintglob[LONG_M]; + char tmpvargridname[LONG_M]; + char dependfilename[LONG_FNAME]; + char charusemodule[LONG_VNAME]; + char subofagrifinitgrids[LONG_M]; + char curmodulename[LONG_VNAME]; + char subroutinename[LONG_VNAME]; + char old_subroutinename[LONG_VNAME]; // For internal subprogramm + char cur_filename[LONG_FNAME]; // Name of the current parsed Fortran file + char config_file[LONG_FNAME]; // Name of conv configuration file (ex: amr.in) + char work_dir[LONG_FNAME]; // Work directory (default: './') + char include_dir[LONG_FNAME]; // Include directory (default: './AGRIF_INC') + char output_dir[LONG_FNAME]; // output directory (default: './AGRIF_MODELFILES') + char input_dir[LONG_FNAME]; // source input directory (default: './') + + FILE *fortran_out; /* Output File */ + FILE *fortran_in; /* Input File */ + FILE *oldfortran_out; + FILE *old_oldfortran_out; // For internal subprogramm + FILE *subloop; + FILE *module_declar; + FILE *allocationagrif; + + long int pos_cur; /* current position in the output file */ + long int pos_curagrifparent; + /* current position in the output file */ + long int pos_curcall; /* current position in the output file */ + long int pos_curuse; /* current position in the output file */ + long int pos_curuseold; /* current position in the output file */ + long int pos_curfunction; /* current position in the output file */ + long int pos_cur_decl; /* current position in the output file */ + long int pos_curdata; /* current position in the output file */ + long int pos_curparameter;/* current position in the output file */ + long int pos_curcommon; /* current position in the output file */ + long int pos_cursave; /* current position in the output file */ + long int pos_curdimension;/* current position in the output file */ + long int pos_curinclude; /* final position of a line in file */ + long int pos_end; /* final position of a line in file */ + long int pos_endsubroutine; + /* final position of a line in file */ + +size_t length_last; +size_t length_first; +size_t length_v_vallengspec; +size_t length_v_commoninfile; +size_t length_v_precision; +size_t length_v_IntentSpec; +size_t length_v_initialvalue; +size_t length_v_readedlistdimension; +size_t length_a_nomvar; +size_t length_toprintglob; +size_t length_tmpvargridname; +size_t length_ligne_Subloop; +size_t length_toprint_utilagrif; +size_t length_toprinttmp_utilchar; +size_t length_ligne_writedecl; +size_t length_newname_toamr; +size_t length_newname_writedecl; +size_t length_ligne_toamr; +size_t length_tmpligne_writedecl; + int value_char_size; + int value_char_size1; + int value_char_size2; + int value_char_size3; + + + int inallocate; + int infixed; + int infree; +/******************************************************************************/ +/*********** Declaration of externals subroutines *****************************/ +/***************************************************** ************************/ +extern char *fortran_text; +/******************************************************************************/ +/*********** convert.y ********************************************************/ +/******************************************************************************/ +extern int main(int argc,char *argv[]); +extern int convert_error(const char *s); +/******************************************************************************/ +/*********** fortran.y ********************************************************/ +/******************************************************************************/ +extern void process_fortran(const char *input_file); +extern int fortran_error(const char *s); +/******************************************************************************/ +/*********** dependfile.c *****************************************************/ +/******************************************************************************/ +extern void Writethedependnbxnbyfile(); +extern void Readthedependnbxnbyfile(); +extern void Writethedependlistofmoduleused(const char *NameTampon ); +extern void Readthedependlistofmoduleused(const char *NameTampon); +extern void WritedependParameterList(const char *NameTampon ); +extern listparameter *ReaddependParameterList(const char *NameTampon, listparameter *listout); +extern void Writethedependfile(const char *NameTampon, listvar *input ); +extern listvar *Readthedependfile(const char *NameTampon , listvar *listout); +extern void Write_Subroutine_For_Alloc(); +extern void Read_Subroutine_For_Alloc(); +extern void Writethedependavailablefile(); +extern void Readthedependavailablefile(); +extern int is_dependfile_created(const char *NameTampon); +extern void Write_val_max(); +extern void Read_val_max(); +/******************************************************************************/ +/*********** DiversListe.c ****************************************************/ +/******************************************************************************/ +extern void Add_Common_var_1(); +extern listnom *Addtolistnom(const char *nom, listnom *listin, int value); +extern listname *Addtolistname(const char *nom, listname *input); +extern int ModuleIsDefineInInputFile(const char *name); +extern void Addmoduletothelisttmp(const char *name); +extern void Add_NameOfModule_1(const char *nom); +extern void Add_NameOfCommon_1(const char *nom, const char *cursubroutinename); +extern void Add_CouplePointed_Var_1(const char *namemodule, listcouple *couple); +extern void Add_Include_1(const char *name); +extern void Add_ImplicitNoneSubroutine_1(); +extern void WriteIncludeDeclaration(FILE* tofile); +extern void Add_Save_Var_1 (const char *name,listdim *d); +extern void Add_Save_Var_dcl_1 (listvar *var); +/******************************************************************************/ +/*********** SubLoopCreation.c ************************************************/ +/******************************************************************************/ +extern void WriteBeginof_SubLoop(); +extern void WriteVariablelist_subloop(char **ligne, size_t *line_length); +extern void WriteVariablelist_subloop_Call(char **ligne, size_t *line_length); +extern void WriteVariablelist_subloop_Def(char **ligne, size_t *line_length); +extern void WriteHeadofSubroutineLoop(); +extern void closeandcallsubloopandincludeit_0(int suborfun); +extern void closeandcallsubloop_contains_0(); +/******************************************************************************/ +/*********** toamr.c **********************************************************/ +/******************************************************************************/ +extern void WARNING_CharSize(const variable *var); +extern const char * tabvarsname(const variable *var); +extern const char * variablecurgridtabvars(int which_grid); +extern const char * vargridnametabvars(const variable *var, int iorindice); +extern const char * vargridcurgridtabvars(const variable *var, int which_grid); +extern const char * vargridcurgridtabvarswithoutAgrif_Gr(const variable *var); +extern const char * vargridparam(const variable *var); +extern void write_probdimagrif_file(); +extern void write_keysagrif_file(); +extern void write_modtypeagrif_file(); +extern void write_createvarnameagrif_file(variable *v,FILE *createvarname,int *InitEmpty); +extern void write_initialisationsagrif_file(variable *v,FILE *initproc,int *VarnameEmpty); +extern void write_Setnumberofcells_file(); +extern void write_Getnumberofcells_file(); +extern void Write_Alloc_Agrif_Files(); +extern int IndiceInlist(int indic, listindice *listin); +extern void write_allocation_Common_0(); +extern void write_allocation_Global_0(); +extern void creefichieramr(); +/******************************************************************************/ +/*********** UtilAgrif.c ******************************************************/ +/******************************************************************************/ +extern int Vartonumber(const char *tokname); +extern int Agrif_in_Tok_NAME(const char *tokname); +extern void ModifyTheVariableName_0(const char *ident,int lengthname); +extern void Add_SubroutineWhereAgrifUsed_1(const char *sub, const char *mod); +extern void AddUseAgrifUtil_0(FILE *fileout); +extern void AddUseAgrifUtilBeforeCall_0(FILE *fileout); +extern void NotifyAgrifFunction_0(const char *ident); +extern void ModifyTheAgrifFunction_0(const char *ident); +extern void AgriffunctionModify_0(const char *ident,int whichone); +extern void Instanciation_0(const char *ident); +/******************************************************************************/ +/*********** UtilCharacter.c **************************************************/ +/******************************************************************************/ +extern void FindAndChangeNameToTabvars(const char name[LONG_M],char toprint[LONG_M], + listvar * listtosee, int whichone); +extern const char *ChangeTheInitalvaluebyTabvarsName(const char *nom,listvar *listtoread); +extern int IsVariableReal(const char *nom); +extern void IsVarInUseFile(const char *nom); +extern listnom *DecomposeTheNameinlistnom(const char *nom, listnom * listout); +extern void DecomposeTheName(const char *nom); +extern void convert2lower(char *lowername, const char* inputname); +extern int convert2int(const char *name); +/******************************************************************************/ +/*********** UtilFile.c *******************************************************/ +/******************************************************************************/ +extern FILE * open_for_write (const char *filename); +extern FILE * open_for_append (const char *filename); +extern long int setposcur(); +extern long int setposcurname(FILE *fileout); +extern void copyuse_0(const char *namemodule); +extern void copyuseonly_0(const char *namemodule); +/******************************************************************************/ +/*********** UtilFortran.c ****************************************************/ +/******************************************************************************/ +extern void initdimprob(int dimprobmod, const char *nx, const char *ny, const char *nz); +extern int Variableshouldberemoved(const char *nom); +extern int variableisglobal(listvar *curvar, listvar *listin); +extern int VariableIsInListCommon(listvar *curvar,listvar *listin); +extern int VariableIsInList(listvar *curvar,listvar *listin); +extern void variableisglobalinmodule(listcouple *listin, const char *module, + FILE *fileout,long int oldposcuruse); +extern void Write_Word_end_module_0(); +extern void Add_Subroutine_For_Alloc(const char *nom); +extern void Write_Closing_Module(); +extern int IsTabvarsUseInArgument_0(); +extern int ImplicitNoneInSubroutine(); +extern void Add_Pointer_Var_From_List_1(listvar *listin); +extern void Add_Pointer_Var_1(char *nom); +extern int varispointer_0(char *ident); +extern int VariableIsFunction(const char *ident); +extern int varistyped_0(char *ident); +extern void dump_var(const variable* var); +extern void removenewline(char *nom); +/******************************************************************************/ +/*********** UtilListe.c ******************************************************/ +/******************************************************************************/ +extern void Init_Variable(variable *var); +extern listvar * AddListvarToListvar(listvar *l,listvar *glob, int ValueFirstpass); +extern void CreateAndFillin_Curvar(const char *type, variable *curvar); +// extern void duplicatelistvar(listvar *orig); +extern listdim * insertdim(listdim *lin,typedim nom); +extern void change_dim_char(listdim *lin,listvar * l); +extern int get_num_dims(const listdim *d); +extern variable * createvar(const char *nom, listdim *d); +extern listvar * insertvar(listvar *lin,variable *v); +extern listvar * settype(const char *nom,listvar *lin); +extern void printliste(listvar * lin); +extern int IsinListe(listvar *lin,char *nom); +extern listname *Insertname(listname *lin,char *nom,int sens); +extern int testandextractfromlist(listname **lin, char*nom); +extern void removefromlist(listname **lin, char*nom); +extern listname *concat_listname(listname *l1, listname *l2); +extern void createstringfromlistname(char *ligne, listname *lin); +extern void printname(listname * lin); +extern void removeglobfromlist(listname **lin); +extern void writelistpublic(listname *lin); +extern void Init_List_Data_Var(); +extern void addprecision_derivedfromkind(variable *curvar); +extern int get_cat_var(variable *var); +extern void Insertdoloop(variable *var,char *do_var, char *do_begin, char *do_end, char *do_step); +/******************************************************************************/ +/*********** UtilNotGridDep.c *************************************************/ +/******************************************************************************/ +extern void Add_NotGridDepend_Var_1 (char *name); +extern int VarIsNonGridDepend(char *name); +/******************************************************************************/ +/*********** WorkWithAllocatelist.c *******************************************/ +/******************************************************************************/ +extern void Add_Allocate_Var_1(const char *nom, const char *nommodule); +extern int IsVarAllocatable_0(const char *ident); +/******************************************************************************/ +/*********** WorkWithglobliste.c **********************************************/ +/******************************************************************************/ +extern void Add_Globliste_1(listvar *listtoadd); +extern void Add_SubroutineDeclarationSave_Var_1(listvar *listtoadd); +extern void checkandchangedims(listvar *listsecondpass); +/******************************************************************************/ +/*********** WorkWithlistdatavariable.c ***************************************/ +/******************************************************************************/ +extern void Add_Data_Var_1 (listvar **curlist,char *name,char *values); +extern void Add_Data_Var_Names_01 (listvar **curlist,listvar *l1, listname *l2); +/******************************************************************************/ +/*********** WorkWithlistmoduleinfile.c ***************************************/ +/******************************************************************************/ +extern void Save_Length(const char *nom, int whichone); +extern void Save_Length_int(int val, int whichone); +/******************************************************************************/ +/*********** WorkWithlistofmodulebysubroutine.c *******************************/ +/******************************************************************************/ +extern void RecordUseModulesVariables(); +extern void RecordUseModulesUseModulesVariables(); +extern void Add_NameOfModuleUsed_1(char *name); +extern void Addmoduletothelist(const char *name); +extern void WriteUsemoduleDeclaration(const char *cursubroutinename); +/******************************************************************************/ +/*********** WorkWithlistvarindoloop.c ****************************************/ +/******************************************************************************/ +extern void Add_UsedInSubroutine_Var_1 (const char *ident); +extern void ajoutevarindoloop_definedimension (char *name); +extern void ModifyThelistvarindoloop(); +extern void CompleteThelistvarindoloop(); +extern void Merge_Variables(variable *var1,variable *var2); +extern void Update_List_Subroutine_Var(listvar *list_to_modify); +extern void Update_List_Global_Var_From_List_Save_Var(); +extern void Update_List_From_Common_Var(listvar *list_to_modify); +extern void Update_List_Var(listvar *list_to_modify); +extern void List_UsedInSubroutine_Var_Update_From_Module_Used(); +extern void Update_NotGridDepend_Var(listvar *list_to_modify); +extern int LookingForVariableInList(listvar *listin,variable *var); +extern int LookingForVariableInListGlobal(listvar *listin,variable *var); +extern int LookingForVariableInListName(listvar *listin,const char *var); +extern int LookingForVariableInListGlob(listvar *listin,variable *var); +extern int LookingForVariableInListParamGlob(listparameter *listin, variable *var); +extern variable *get_variable_in_list_from_name(listvar *listin, const char *name); +extern void UpdateListDeclarationWithDimensionList(); +extern void Clean_List_UsedInSubroutine_Var(); +extern void Clean_List_ModuleUsed_Var(); +extern void Clean_List_SubroutineDeclaration_Var(); +extern void Clean_List_Global_Var(); +extern void ListClean(); +extern void ListUpdate(); +extern void GiveTypeOfVariables(); +extern void Sort_List_SubroutineArgument_Var(); +extern void IndiceTabvars_Global_Var_Treated(char *nom); +extern void IndiceTabvars_Global_Var_No_Treated(char *nom); +extern void UpdateTheRemainingList(listvar *record); +extern void IndiceTabvars_Common_Var_Treated(char *nom); +extern void IndiceTabvars_Common_Var_No_Treated(char *nom); +extern void IndiceTabvarsIdentification(); +extern void New_Allocate_Subroutine_Is_Necessary(); +extern void New_Allocate_Subroutine_For_Common_Is_Necessary(); +extern void NewModule_Creation_0(); +extern void UpdateList_SubroutineWhereAgrifUsed(); +extern void UpdateList_UsedInSubroutine_With_dimension(); +extern void Affiche(listvar *parcours); +extern int SubInList_ContainsSubroutine(); +extern void update_indicemaxtabvars(variable *var,listindice **Listofindices); +/******************************************************************************/ +/*********** WorkWithParameterlist.c ******************************************/ +/******************************************************************************/ +extern void Add_GlobalParameter_Var_1(listvar *listin); +extern void Add_Parameter_Var_1(listvar *listin); +extern void Add_Dimension_Var_1(listvar *listin); +/******************************************************************************/ +/*********** WorkWithvarofsubroutineliste.c ***********************************/ +/******************************************************************************/ +extern void Add_SubroutineArgument_Var_1(listvar *listtoadd); +extern void Add_FunctionType_Var_1(const char *nom); +// extern void Add_SubroutineDeclaration_Var_1 (listvar *listtoadd); +/******************************************************************************/ +/*********** Writedeclarations.c **********************************************/ +/******************************************************************************/ +extern void WriteBeginDeclaration(variable *v,char ligne[LONG_M],int visibility); +extern void WriteScalarDeclaration(variable *v,char ligne[LONG_M]); +extern void WriteTableDeclaration(variable * v,char ligne[LONG_M],int tmpok); +extern void WriteVarDeclaration( variable *v, FILE *fileout, int value, int visibility ); +extern void WriteLocalParamDeclaration(FILE* tofile); +extern void WriteFunctionDeclaration(FILE* tofile, int value); +extern void WriteSubroutineDeclaration(int value); +extern void WriteArgumentDeclaration_beforecall(); +extern void WriteArgumentDeclaration_Sort(FILE* tofile); +extern int writedeclarationintoamr(listvar *deb_common, FILE *fileout, variable *var, + const char *commonname, listnom **neededparameter, const char *name_common, int global_check); +extern void writesub_loopdeclaration_scalar(listvar *deb_common, FILE *fileout); +extern void writesub_loopdeclaration_tab(listvar *deb_common, FILE *fileout); +extern void ReWriteDeclarationAndAddTosubroutine_01(listvar *listdecl); +extern void ReWriteDataStatement_0(FILE * filout); +/******************************************************************************/ +/*********** WriteInFile.c ****************************************************/ +/******************************************************************************/ +extern void tofich_reste (FILE * filout, const char *s, int do_returnline); +extern void tofich (FILE * filout, const char *s, int do_returnline); +extern void tofich_blanc (FILE * filout, int size); +extern void RemoveWordSET_0(FILE * filout, long int position, int sizetoremove); +extern void RemoveWordCUR_0(FILE * filout, int sizetoremove); + +/******************************************************************************/ +/*********** WorkWithlistofcoupled.c **********************************************/ +/******************************************************************************/ +extern int variscoupled_0(const char *ident) ; +extern const char * getcoupledname_0(const char *ident); diff --git a/CROCO/croco-v1.3.1/AGRIF/LIB/dependfile.c b/CROCO/croco-v1.3.1/AGRIF/LIB/dependfile.c new file mode 100644 index 00000000..19d66358 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/LIB/dependfile.c @@ -0,0 +1,974 @@ +/******************************************************************************/ +/* */ +/* CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran) */ +/* */ +/* Copyright or or Copr. Laurent Debreu (Laurent.Debreu@imag.fr) */ +/* Cyril Mazauric (Cyril_Mazauric@yahoo.fr) */ +/* This software is governed by the CeCILL-C license under French law and */ +/* abiding by the rules of distribution of free software. You can use, */ +/* modify and/ or redistribute the software under the terms of the CeCILL-C */ +/* license as circulated by CEA, CNRS and INRIA at the following URL */ +/* "http://www.cecill.info". */ +/* */ +/* As a counterpart to the access to the source code and rights to copy, */ +/* modify and redistribute granted by the license, users are provided only */ +/* with a limited warranty and the software's author, the holder of the */ +/* economic rights, and the successive licensors have only limited */ +/* liability. */ +/* */ +/* In this respect, the user's attention is drawn to the risks associated */ +/* with loading, using, modifying and/or developing or reproducing the */ +/* software by the user in light of its specific status of free software, */ +/* that may mean that it is complicated to manipulate, and that also */ +/* therefore means that it is reserved for developers and experienced */ +/* professionals having in-depth computer knowledge. Users are therefore */ +/* encouraged to load and test the software's suitability as regards their */ +/* requirements in conditions enabling the security of their systems and/or */ +/* data to be ensured and, more generally, to use and operate it in the */ +/* same conditions as regards security. */ +/* */ +/* The fact that you are presently reading this means that you have had */ +/* knowledge of the CeCILL-C license and that you accept its terms. */ +/******************************************************************************/ +/* version 1.7 */ +/******************************************************************************/ +#include +#include +#include +#include "decl.h" + + +/******************************************************************************/ +/* Creation and modification of .dependfile */ +/******************************************************************************/ +/* .dependnbxnby : this file contains tabvars indices of variables*/ +/* given in agrif.in as number of cells */ +/* .dependuse : this file contains all modules used in the */ +/* current file */ +/* .dependparameter : this file contains all parmeters defined in */ +/* the current file */ +/* .depend : this file contains all globals variables */ +/* informations (name, dim, etc ...) */ +/* .dependavailable : this file contains all tabvars indices which */ +/* are not used. */ +/******************************************************************************/ + + +/******************************************************************************/ +/* Writethedependnbxnbyfile */ +/******************************************************************************/ +/* This subroutine is used to create the .dependnbxnby */ +/******************************************************************************/ +/* */ +/* .dependnbxnby */ +/* */ +/* nbmaillesX */ +/* nbmaillesY */ +/* nbmaillesZ */ +/* */ +/******************************************************************************/ +void Writethedependnbxnbyfile() +{ + FILE *dependfileoutput; + listvar *parcours; + int out; + + // We look in 'List_Global_Var' for all the variables of the current file to parse + parcours = List_Global_Var; + out = 0; + while (parcours && out == 0 ) + { + if ( !strcasecmp(parcours->var->v_nomvar,nbmaillesX) ) out = 1; + else parcours = parcours->suiv; + } + if ( out == 0 ) + { + parcours =List_Common_Var; + while (parcours && out == 0 ) + { + if ( !strcasecmp(parcours->var->v_nomvar,nbmaillesX) ) out = 1; + else parcours = parcours->suiv; + } + } + NbMailleXDefined = 0; + if ( out == 1 ) + { + NbMailleXDefined = 1; + sprintf(dependfilename, "%s/.dependnbxnby", work_dir); + dependfileoutput = fopen(dependfilename, "w"); + + fprintf(dependfileoutput,"%d\n",parcours->var->v_indicetabvars); + IndicenbmaillesX = parcours->var->v_indicetabvars; + + if ( dimprob > 1 ) + { + parcours =List_Global_Var; + out = 0; + while (parcours && out == 0 ) + { + if ( !strcasecmp(parcours->var->v_nomvar,nbmaillesY) ) out = 1; + else parcours = parcours->suiv; + } + if ( out == 0 ) + { + parcours =List_Common_Var; + while (parcours && out == 0 ) + { + if ( !strcasecmp(parcours->var->v_nomvar,nbmaillesY) ) out = 1; + else parcours = parcours->suiv; + } + } + if ( out == 1 ) + { + fprintf(dependfileoutput,"%d\n",parcours->var->v_indicetabvars); + IndicenbmaillesY = parcours->var->v_indicetabvars; + } + } + + if ( dimprob > 2 ) + { + parcours =List_Global_Var; + out = 0; + while (parcours && out == 0 ) + { + if ( !strcasecmp(parcours->var->v_nomvar,nbmaillesZ) ) out = 1; + else parcours = parcours->suiv; + } + if ( out == 0 ) + { + parcours =List_Common_Var; + while (parcours && out == 0 ) + { + if ( !strcasecmp(parcours->var->v_nomvar,nbmaillesZ) ) out = 1; + else parcours = parcours->suiv; + } + } + if ( out == 1 ) + { + fprintf(dependfileoutput,"%d\n",parcours->var->v_indicetabvars); + IndicenbmaillesZ = parcours->var->v_indicetabvars; + } + } + + if ( out == 1 ) fclose(dependfileoutput); + } +} + +/******************************************************************************/ +/* Readthedependnbxnbyfile */ +/******************************************************************************/ +/* This subroutine is used to create the .dependnbxnby */ +/******************************************************************************/ +/* */ +/* .dependnbxnby */ +/* */ +/* nbmaillesX */ +/* nbmaillesY */ +/* nbmaillesZ */ +/* */ +/******************************************************************************/ +void Readthedependnbxnbyfile() +{ + FILE *dependfileoutput; + + sprintf(dependfilename, "%s/.dependnbxnby", work_dir); + if ((dependfileoutput = fopen(dependfilename, "r"))!=NULL) + { + fscanf(dependfileoutput,"%d\n",&IndicenbmaillesX); + if ( dimprob > 1 ) fscanf(dependfileoutput,"%d\n",&IndicenbmaillesY); + if ( dimprob > 2 ) fscanf(dependfileoutput,"%d\n",&IndicenbmaillesZ); + fclose(dependfileoutput); + } +} + +/******************************************************************************/ +/* Writethedependlistofmoduleused */ +/******************************************************************************/ +/* This subroutine is used to create the .dependuse */ +/******************************************************************************/ +/* */ +/* .dependuse */ +/* */ +/* mod1 */ +/* mod2 */ +/* */ +/******************************************************************************/ +void Writethedependlistofmoduleused(const char *NameTampon ) +{ + FILE *dependfileoutput; + listusemodule *parcours; + char lowername[LONG_VNAME]; + + if ( ! List_NameOfModuleUsed ) return; + + convert2lower(lowername, NameTampon); + sprintf(dependfilename, "%s/.depend_use%s", work_dir, lowername); + dependfileoutput = fopen(dependfilename, "w"); + + parcours = List_NameOfModuleUsed; + while (parcours) + { + if ( !strcasecmp(lowername,parcours->u_modulename) && + !strcasecmp(parcours->u_cursubroutine,"") ) + { + // We look in 'List_NameOfModuleUsed' for all the variables of the current file to parse + fprintf(dependfileoutput,"%s\n",parcours->u_usemodule); + } + parcours = parcours->suiv; + } + fclose(dependfileoutput); +} + +/******************************************************************************/ +/* Readthedependlistofmoduleused */ +/******************************************************************************/ +/* This subroutine is used to create the .dependuse */ +/******************************************************************************/ +/* */ +/* .dependuse */ +/* */ +/* mod1 */ +/* mod2 */ +/* */ +/******************************************************************************/ +void Readthedependlistofmoduleused(const char *NameTampon) +{ + FILE *dependfileoutput; + listusemodule *parcours; + char lowername[LONG_VNAME]; + + tmpuselocallist = (listusemodule *)NULL; + + convert2lower(lowername, NameTampon); + sprintf(dependfilename, "%s/.depend_use%s", work_dir, lowername); + + if ((dependfileoutput = fopen(dependfilename, "r"))!=NULL) + { + /* if the file exist we should verify that this file has changed */ + while (!feof(dependfileoutput)) + { + parcours=(listusemodule *)calloc(1,sizeof(listusemodule)); + fscanf(dependfileoutput,"%s\n",parcours->u_usemodule); + + parcours->suiv = tmpuselocallist; + tmpuselocallist = parcours; + + parcours = NULL; + } + fclose(dependfileoutput); + } +} + + +/******************************************************************************/ +/* WritedependParameterList */ +/******************************************************************************/ +/* This subroutine is used to create the .dependparameter */ +/******************************************************************************/ +/* */ +/* .dependparameter */ +/* */ +/* mod1 */ +/* mod2 */ +/* */ +/******************************************************************************/ +void WritedependParameterList(const char *NameTampon ) +{ + FILE *dependfileoutput; + listvar *parcours; + char lowername[LONG_VNAME]; + + if ( List_GlobalParameter_Var ) + { + convert2lower(lowername, NameTampon); + sprintf(dependfilename, "%s/.depend_paramater_%s", work_dir, lowername); + + dependfileoutput = fopen(dependfilename, "w"); + parcours = List_GlobalParameter_Var; + while (parcours) + { + if ( !strcasecmp(lowername, parcours->var->v_modulename) ) + { + fprintf(dependfileoutput,"%s\n",parcours->var->v_nomvar); + fprintf(dependfileoutput,"%s\n",parcours->var->v_modulename); + } + parcours = parcours->suiv; + } + fclose(dependfileoutput); + } +} + + +/******************************************************************************/ +/* ReaddependParameterList */ +/******************************************************************************/ +/* This subroutine is used to create the .dependparameter */ +/******************************************************************************/ +/* */ +/* .dependparameter */ +/* */ +/* mod1 */ +/* mod2 */ +/* */ +/******************************************************************************/ +listparameter *ReaddependParameterList(const char *NameTampon,listparameter *listout) +{ + FILE *dependfileoutput; + listparameter *parcours; + char lowername[LONG_VNAME]; + + convert2lower(lowername, NameTampon); + sprintf(dependfilename, "%s/.depend_paramater_%s", work_dir, lowername); + + if ((dependfileoutput = fopen(dependfilename,"r"))!=NULL) + { + /* if the file exist we should verify that this file has changed */ + while (!feof(dependfileoutput)) + { + parcours=(listparameter *)calloc(1,sizeof(listparameter)); + fscanf(dependfileoutput,"%s\n",parcours->p_name); + fscanf(dependfileoutput,"%s\n",parcours->p_modulename); + + parcours->suiv = listout; + listout = parcours; + + parcours = NULL; + } + fclose(dependfileoutput); + } + return listout; +} + +/******************************************************************************/ +/* Writethedependfile */ +/******************************************************************************/ +/* This subroutine is used to create the .depend */ +/******************************************************************************/ +/* */ +/* .depend */ +/* */ +/* REAL */ +/* Variable */ +/* char dimension or T */ +/* table dimension */ +/* is type given */ +/* precision or T */ +/* initial value or T */ +/* indice in the tabvars */ +/* listdimension or T */ +/* ------------------------- */ +/* */ +/******************************************************************************/ +void Writethedependfile(const char *NameTampon, listvar *input ) +{ + FILE *dependfileoutput; + listvar *parcours; + listdim *dims; + char ligne[LONG_M]; + char listdimension[LONG_M]; + char curname[LONG_M]; + char lowername[LONG_VNAME]; + int out; + + if ( input ) + { + convert2lower(lowername, NameTampon); + sprintf(dependfilename, "%s/.depend_%s", work_dir, lowername); + + dependfileoutput = fopen(dependfilename,"w"); + // We look in 'input' for all the variables of the current file to parse + parcours =input; + out = 0; + strcpy(curname,""); + while (parcours && out == 0 ) + { + if ( !strcasecmp(parcours->var->v_modulename, lowername) || + !strcasecmp(parcours->var->v_commonname, lowername) ) + { + /* */ + if ( strcasecmp(curname,"") && + !strcasecmp(curname,parcours->var->v_nomvar) ) out = 1 ; + if ( !strcasecmp(curname,"") ) strcpy(curname,parcours->var->v_nomvar); + /* */ + if ( out == 0 ) + { + /********** TYPEVAR ************************************************/ + fprintf(dependfileoutput,"%s\n",parcours->var->v_typevar); + /********** CATVAR ************************************************/ + fprintf(dependfileoutput,"%d\n",parcours->var->v_catvar); + /********** NOMVAR *************************************************/ + fprintf(dependfileoutput,"%s\n",parcours->var->v_nomvar); + /********** DIMCHAR ************************************************/ + if ( strcasecmp(parcours->var->v_dimchar, "") ) + { + fprintf(dependfileoutput,"%s\n",parcours->var->v_dimchar); + } + else + { + fprintf(dependfileoutput,"T\n"); + } + /********** COMMONINFILE *******************************************/ + if ( strcasecmp(parcours->var->v_commoninfile,"") ) + { + fprintf(dependfileoutput,"%s\n",parcours->var->v_commoninfile); + } + else + { + fprintf(dependfileoutput,"T\n"); + } + /********** COMMONNAME *********************************************/ + if ( strcasecmp(parcours->var->v_commonname,"") ) + { + fprintf(dependfileoutput,"%s\n",parcours->var->v_commonname); + } + else + { + fprintf(dependfileoutput,"T\n"); + } + /********** MODULENAME *********************************************/ + if ( strcasecmp(parcours->var->v_modulename,"") ) + { + fprintf(dependfileoutput,"%s\n",parcours->var->v_modulename); + } + else + { + fprintf(dependfileoutput,"T\n"); + } + /********** NBDIM **************************************************/ +/* fprintf(dependfileoutput,"%d\n",parcours->var->v_nbdim);*/ + /********** DIMENSIONGIVEN *****************************************/ +/* fprintf(dependfileoutput,"%d\n",parcours->var->v_dimensiongiven);*/ + /********** ALLOCATABLE ********************************************/ + fprintf(dependfileoutput,"%d\n",parcours->var->v_allocatable); + /********** TARGET ********************************************/ + fprintf(dependfileoutput,"%d\n",parcours->var->v_target); + /********** POINTERDECLARE *****************************************/ + fprintf(dependfileoutput,"%d\n",parcours->var->v_pointerdeclare); + /********** PRECISION **********************************************/ + if ( strcasecmp(parcours->var->v_precision,"") ) + { + fprintf(dependfileoutput,"%s\n",parcours->var->v_precision); + } + else + { + fprintf(dependfileoutput,"T\n"); + } + /********** INITIALVALUE *******************************************/ +/* if ( strcasecmp(parcours->var->v_initialvalue,"") ) + { + fprintf(dependfileoutput,"%s\n",parcours->var->v_initialvalue); + } + else + { + fprintf(dependfileoutput,"T\n"); + }*/ + /********** NAMEINTYPENAME *****************************************/ + if ( strcasecmp(parcours->var->v_nameinttypename,"") ) + { + fprintf(dependfileoutput,"%s\n",parcours->var->v_nameinttypename); + } + else + { + fprintf(dependfileoutput,"T\n"); + } + /********** PRIVATE *****************************************/ + fprintf(dependfileoutput,"%d\n",parcours->var->v_PrivateDeclare); + + /********** INDICETABVARS ******************************************/ + fprintf(dependfileoutput,"%d\n",parcours->var->v_indicetabvars); + /********** READEDLISTDIMENSION ************************************/ + if ( parcours->var->v_dimensiongiven == 1 ) + { + dims = parcours->var->v_dimension; + strcpy(listdimension,""); + while (dims) + { + sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last); + strcat(listdimension,ligne); + if ( dims->suiv ) + { + strcat(listdimension,","); + } + dims = dims->suiv; + } + Save_Length(listdimension,15); + fprintf(dependfileoutput,"%s\n",listdimension); + } + else + { + fprintf(dependfileoutput,"T\n"); + } + /*******************************************************************/ + fprintf(dependfileoutput,"------------------------\n"); + } + } + parcours = parcours->suiv; + } + fclose(dependfileoutput); + } +} + +/******************************************************************************/ +/* Readthedependfile */ +/******************************************************************************/ +/* This subroutine is used to read the .dependfile and to insert new */ +/* information in the listout list. */ +/******************************************************************************/ +/* */ +/* .dependmodule --------> = list of var */ +/* */ +/* not.dependmodule --------> */ +/* */ +/******************************************************************************/ +listvar *Readthedependfile(const char *NameTampon , listvar *listout) +{ + FILE *dependfileoutput; + listvar *parcours0; + listvar *parcours; + listvar *parcoursprec; + char nothing[LONG_M]; + char lowername[LONG_VNAME]; + size_t i; + + parcoursprec = (listvar *)NULL; + + convert2lower(lowername, NameTampon); + sprintf(dependfilename, "%s/.depend_%s", work_dir, lowername); + + if ((dependfileoutput = fopen(dependfilename, "r"))==NULL) + { + /* if the file doesn't exist it means that it is the first time */ + /* we tried to parse this file */ + } + else + { + /* if the file exist we should verify that this file has changed */ + while (!feof(dependfileoutput)) + { + parcours=(listvar *)calloc(1,sizeof(listvar)); + parcours->var=(variable *)calloc(1,sizeof(variable)); + /* */ + Init_Variable(parcours->var); + /* */ + /********** TYPEVAR ************************************************/ + fscanf(dependfileoutput,"%s\n",parcours->var->v_typevar); + /********** CATVAR ************************************************/ + fscanf(dependfileoutput,"%d\n",&parcours->var->v_catvar); + /********** NOMVAR *************************************************/ + fscanf(dependfileoutput,"%s\n",parcours->var->v_nomvar); + /********** DIMCHAR ************************************************/ + fscanf(dependfileoutput,"%s\n",parcours->var->v_dimchar); + if ( !strcasecmp(parcours->var->v_dimchar,"T") ) + { + strcpy(parcours->var->v_dimchar,""); + } + /********** COMMONINFILE *******************************************/ + fscanf(dependfileoutput,"%s\n",parcours->var->v_commoninfile); + if ( !strcasecmp(parcours->var->v_commoninfile,"T") ) + { + strcpy(parcours->var->v_commoninfile,""); + } + /********** COMMONNAME *********************************************/ + fscanf(dependfileoutput,"%s\n",parcours->var->v_commonname); + if ( !strcasecmp(parcours->var->v_commonname,"T") ) + { + strcpy(parcours->var->v_commonname,""); + } + /********** MODULENAME *********************************************/ + fscanf(dependfileoutput,"%s\n",parcours->var->v_modulename); + + if ( !strcasecmp(parcours->var->v_modulename,"T") ) + { + strcpy(parcours->var->v_modulename,""); + } + + + /********** NBDIM **************************************************/ +/* fscanf(dependfileoutput,"%d\n",&parcours->var->v_nbdim);*/ + /********** DIMENSIONGIVEN *****************************************/ +/* fscanf(dependfileoutput,"%d\n",&parcours->var->v_dimensiongiven);*/ + /********** ALLOCATABLE ********************************************/ + fscanf(dependfileoutput,"%d\n",&parcours->var->v_allocatable); + if ( parcours->var->v_allocatable == 1 ) + { + Add_Allocate_Var_1(parcours->var->v_nomvar, parcours->var->v_commonname); + } + /********** TARGET ********************************************/ + fscanf(dependfileoutput,"%d\n",&parcours->var->v_target); + + /********** POINTERDECLARE *****************************************/ + fscanf(dependfileoutput,"%d\n",&parcours->var->v_pointerdeclare); + if ( parcours->var->v_pointerdeclare == 1 ) + { + Add_Pointer_Var_1(parcours->var->v_nomvar); + } + /********** PRECISION **********************************************/ + fscanf(dependfileoutput,"%[^\n] \n",parcours->var->v_precision); + if ( !strcasecmp(parcours->var->v_precision,"T") ) + { + strcpy(parcours->var->v_precision,""); + } + /********** INITIALVALUE *******************************************/ +/* fscanf(dependfileoutput,"%[^\n] \n",parcours->var->v_initialvalue); + if ( !strcasecmp(parcours->var->v_initialvalue,"T") ) + { + strcpy(parcours->var->v_initialvalue,""); + }*/ + /********** NAMEINTYPENAME *****************************************/ + fscanf(dependfileoutput,"%[^\n] \n",parcours->var->v_nameinttypename); + if ( !strcasecmp(parcours->var->v_nameinttypename,"T") ) + { + strcpy(parcours->var->v_nameinttypename,""); + } + /********** PRIVATE *****************************************/ + fscanf(dependfileoutput,"%d\n",&parcours->var->v_PrivateDeclare); + + /********** INDICETABVARS ******************************************/ + fscanf(dependfileoutput,"%d\n",&parcours->var->v_indicetabvars); + /********** READEDLISTDIMENSION ************************************/ + fscanf(dependfileoutput,"%s\n",parcours->var->v_readedlistdimension); + if ( !strcasecmp(parcours->var->v_readedlistdimension,"T") ) + { + strcpy(parcours->var->v_readedlistdimension,""); + } + else + { + parcours->var->v_dimensiongiven = 1; + parcours->var->v_nbdim = 1; + i = 1; + /* */ + while ( i < strlen(parcours->var->v_readedlistdimension) ) + { + if ( parcours->var->v_readedlistdimension[i] == ',' ) + { + parcours->var->v_nbdim = parcours->var->v_nbdim + 1 ; + } + /* */ + i=i+1; + } + } + /*******************************************************************/ + fscanf(dependfileoutput,"%s\n",nothing); + parcours->suiv = NULL; + if (parcours->var->v_PrivateDeclare == 0) + { + if ( !listout ) + { + listout = parcours; + parcoursprec = parcours; + } + else + { + if ( parcoursprec ) + { + parcoursprec->suiv = parcours; + parcoursprec = parcours; + } + else + { + parcours0 = listout; + while ( parcours0->suiv ) parcours0=parcours0->suiv; + parcours0->suiv = parcours; + parcoursprec = parcours0->suiv; + } + } + } + parcours = NULL; + } + fclose(dependfileoutput); + } + return listout; +} + +void Write_Subroutine_For_Alloc() +{ + FILE *dependfileoutput; + listnom *parcours; + + if ( List_Subroutine_For_Alloc ) + { + sprintf(dependfilename, "%s/.dependAllocAgrif", work_dir); + + if ((dependfileoutput=fopen(dependfilename, "w"))!=NULL) + { + parcours = List_Subroutine_For_Alloc; + while (parcours) + { + fprintf(dependfileoutput,"%s\n",parcours->o_nom); + parcours = parcours->suiv; + } + fclose(dependfileoutput); + } + } +} + +void Read_Subroutine_For_Alloc() +{ + FILE *dependfileoutput; + listnom *parcours; + listnom *ref; + + ref = (listnom*) NULL; + sprintf(dependfilename, "%s/.dependAllocAgrif", work_dir); + + if ( (dependfileoutput=fopen(dependfilename, "r")) != NULL ) + { + List_Subroutine_For_Alloc = (listnom*) NULL; + while ( !feof(dependfileoutput) ) + { + parcours = (listnom*) calloc(1,sizeof(listnom)); + strcpy(parcours->o_nom,""); + + fscanf(dependfileoutput,"%s\n",parcours->o_nom); + parcours->suiv = NULL; + + if ( !List_Subroutine_For_Alloc ) + { + List_Subroutine_For_Alloc = parcours; + } + else + { + ref->suiv = parcours; + } + ref = parcours; + } + fclose(dependfileoutput); + } +} + +/******************************************************************************/ +/* Writethedependavailablefile */ +/******************************************************************************/ +/* This subroutine is used to write the .dependfileavailable file */ +/******************************************************************************/ +/* */ +/* .dependavailable */ +/* tabvars(1) = var1 */ +/* tabvars(3) = var1 2 */ +/* tabvars(4) = var1 =====> 5 */ +/* tabvars(6) = var1 */ +/* tabvars(7) = var1 */ +/* */ +/* */ +/* */ +/******************************************************************************/ +void Writethedependavailablefile() +{ + FILE *dependfileoutput; + listindice *parcours; + int i; + + sprintf(dependfilename, "%s/.dependavailable", work_dir); + + if ((dependfileoutput=fopen(dependfilename, "w"))!=NULL) + { + /* We are looking for all the indices of the Listofavailableindices */ + for (i=0;ii_indice != 0 ) + { + fprintf(dependfileoutput,"%d %d\n",i,parcours->i_indice); + } + parcours = parcours->suiv; + } + } + fclose(dependfileoutput); + } +} + +/******************************************************************************/ +/* Readthedependavailablefile */ +/******************************************************************************/ +/* This subroutine is used to read the .dependfileavailable file */ +/******************************************************************************/ +/* */ +/* .dependavailable */ +/* tabvars(1) = var1 */ +/* tabvars(3) = var1 2 */ +/* tabvars(4) = var1 =====> 5 ==> Listofavailableindices */ +/* tabvars(6) = var1 */ +/* tabvars(7) = var1 */ +/* */ +/* */ +/* */ +/******************************************************************************/ +void Readthedependavailablefile() +{ + FILE *dependfileoutput; + listindice *parcours; + int current_cat; + + sprintf(dependfilename, "%s/.dependavailable", work_dir); + + if ((dependfileoutput=fopen(dependfilename, "r"))!=NULL) + { + /* We are looking for all the indices of the Listofavailableindices */ + Listofavailableindices_glob = (listindice **) calloc(NB_CAT_VARIABLES,sizeof(listindice *)); + while (!feof(dependfileoutput)) + { + parcours=(listindice *)calloc(1,sizeof(listindice)); + fscanf(dependfileoutput,"%d %d\n",¤t_cat,&parcours->i_indice); + if ( parcours->i_indice != 0 && parcours->i_indice < 10000000 ) + { + parcours -> suiv = Listofavailableindices_glob[current_cat]; + Listofavailableindices_glob[current_cat] = parcours; + } + else + { + free(parcours); + } + } + fclose(dependfileoutput); + } +} + + +/******************************************************************************/ +/* is_dependfile_created */ +/******************************************************************************/ +/* This subroutine is used to know if the .depend exist */ +/* it means if the file has been ever parsed */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +int is_dependfile_created(const char *NameTampon) +{ + FILE *dependfileoutput; + char lowername[LONG_VNAME]; + + convert2lower(lowername, NameTampon); + sprintf(dependfilename, "%s/.depend_%s", work_dir, lowername); + + dependfileoutput = fopen(dependfilename, "r"); + + if ( (dependfileoutput = fopen(dependfilename, "r")) != NULL ) + { + fclose(dependfileoutput); + return 1; + } + else + return 0; +} + +void Write_val_max() +{ + FILE *dependfileoutput; + + sprintf(dependfilename, "%s/.dependvalmax", work_dir); + + if ((dependfileoutput=fopen(dependfilename, "w"))!=NULL) + { + fprintf(dependfileoutput,"length_last\n"); + fprintf(dependfileoutput,"%lu\n", length_last); + fprintf(dependfileoutput,"length_first\n"); + fprintf(dependfileoutput,"%lu\n", length_first); + fprintf(dependfileoutput,"length_v_vallengspec\n"); + fprintf(dependfileoutput,"%lu\n", length_v_vallengspec); + fprintf(dependfileoutput,"length_v_commoninfile\n"); + fprintf(dependfileoutput,"%lu\n", length_v_commoninfile); + fprintf(dependfileoutput,"length_v_precision\n"); + fprintf(dependfileoutput,"%lu\n", length_v_precision); + fprintf(dependfileoutput,"length_v_IntentSpec\n"); + fprintf(dependfileoutput,"%lu\n", length_v_IntentSpec); + fprintf(dependfileoutput,"length_v_initialvalue\n"); + fprintf(dependfileoutput,"%lu\n", length_v_initialvalue); + fprintf(dependfileoutput,"length_v_readedlistdimension\n"); + fprintf(dependfileoutput,"%lu\n", length_v_readedlistdimension); + fprintf(dependfileoutput,"length_a_nomvar\n"); + fprintf(dependfileoutput,"%lu\n", length_a_nomvar); + fprintf(dependfileoutput,"length_toprintglob\n"); + fprintf(dependfileoutput,"%lu\n", length_toprintglob); + fprintf(dependfileoutput,"Size_char0d\n"); + fprintf(dependfileoutput,"%d\n",value_char_size); + fprintf(dependfileoutput,"Size_char1d\n"); + fprintf(dependfileoutput,"%d\n",value_char_size1); + fprintf(dependfileoutput,"Size_char2d\n"); + fprintf(dependfileoutput,"%d\n",value_char_size2); + fprintf(dependfileoutput,"Size_char3d\n"); + fprintf(dependfileoutput,"%d\n",value_char_size3); + fprintf(dependfileoutput,"length_tmpvargridname\n"); + fprintf(dependfileoutput,"%lu\n", length_tmpvargridname); + fprintf(dependfileoutput,"length_ligne_Subloop\n"); + fprintf(dependfileoutput,"%lu\n", length_ligne_Subloop); + fprintf(dependfileoutput,"length_toprint_toamr\n"); + fprintf(dependfileoutput,"%lu\n", length_toprint_utilagrif); + fprintf(dependfileoutput,"length_toprinttmp_utilchar\n"); + fprintf(dependfileoutput,"%lu\n", length_toprinttmp_utilchar); + fprintf(dependfileoutput,"length_ligne_writedecl\n"); + fprintf(dependfileoutput,"%lu\n", length_ligne_writedecl); + fprintf(dependfileoutput,"length_newname_toamr\n"); + fprintf(dependfileoutput,"%lu\n", length_newname_toamr); + fprintf(dependfileoutput,"length_newname_writedecl\n"); + fprintf(dependfileoutput,"%lu\n", length_newname_writedecl); + fprintf(dependfileoutput,"length_ligne_toamr\n"); + fprintf(dependfileoutput,"%lu\n", length_ligne_toamr); + fprintf(dependfileoutput,"length_tmpligne_writedecl\n"); + fprintf(dependfileoutput,"%lu\n", length_tmpligne_writedecl); + + fclose(dependfileoutput); + } +} + + +void Read_val_max() +{ + char nothing[LONG_M]; + FILE *dependfileoutput; + + sprintf(dependfilename, "%s/.dependvalmax", work_dir); + + if ((dependfileoutput=fopen(".dependvalmax","r"))!=NULL) + { + fscanf(dependfileoutput,"%s\n",nothing); + fscanf(dependfileoutput,"%lu\n", &length_last); + fscanf(dependfileoutput,"%s\n",nothing); + fscanf(dependfileoutput,"%lu\n", &length_first); + fscanf(dependfileoutput,"%s\n",nothing); + fscanf(dependfileoutput,"%lu\n", &length_v_vallengspec); + fscanf(dependfileoutput,"%s\n",nothing); + fscanf(dependfileoutput,"%lu\n", &length_v_commoninfile); + fscanf(dependfileoutput,"%s\n",nothing); + fscanf(dependfileoutput,"%lu\n", &length_v_precision); + fscanf(dependfileoutput,"%s\n",nothing); + fscanf(dependfileoutput,"%lu\n", &length_v_IntentSpec); + fscanf(dependfileoutput,"%s\n",nothing); + fscanf(dependfileoutput,"%lu\n", &length_v_initialvalue); + fscanf(dependfileoutput,"%s\n",nothing); + fscanf(dependfileoutput,"%lu\n", &length_v_readedlistdimension); + fscanf(dependfileoutput,"%s\n",nothing); + fscanf(dependfileoutput,"%lu\n", &length_a_nomvar); + fscanf(dependfileoutput,"%s\n",nothing); + fscanf(dependfileoutput,"%lu\n", &length_toprintglob); + fscanf(dependfileoutput,"%s\n",nothing); + fscanf(dependfileoutput,"%d\n", &value_char_size); + fscanf(dependfileoutput,"%s\n", nothing); + fscanf(dependfileoutput,"%d\n", &value_char_size1); + fscanf(dependfileoutput,"%s\n", nothing); + fscanf(dependfileoutput,"%d\n", &value_char_size2); + fscanf(dependfileoutput,"%s\n", nothing); + fscanf(dependfileoutput,"%d\n", &value_char_size3); + fscanf(dependfileoutput,"%s\n",nothing); + fscanf(dependfileoutput,"%lu\n", &length_tmpvargridname); + fscanf(dependfileoutput,"%s\n",nothing); + fscanf(dependfileoutput,"%lu\n", &length_ligne_Subloop); + fscanf(dependfileoutput,"%s\n",nothing); + fscanf(dependfileoutput,"%lu\n", &length_toprint_utilagrif); + fscanf(dependfileoutput,"%s\n",nothing); + fscanf(dependfileoutput,"%lu\n", &length_toprinttmp_utilchar); + fscanf(dependfileoutput,"%s\n",nothing); + fscanf(dependfileoutput,"%lu\n", &length_ligne_writedecl); + fscanf(dependfileoutput,"%s\n",nothing); + fscanf(dependfileoutput,"%lu\n", &length_newname_toamr); + fscanf(dependfileoutput,"%s\n",nothing); + fscanf(dependfileoutput,"%lu\n", &length_newname_writedecl); + fscanf(dependfileoutput,"%s\n",nothing); + fscanf(dependfileoutput,"%lu\n", &length_ligne_toamr); + fscanf(dependfileoutput,"%s\n",nothing); + fscanf(dependfileoutput,"%lu\n", &length_tmpligne_writedecl); + + fclose(dependfileoutput); + } +} diff --git a/CROCO/croco-v1.3.1/AGRIF/LIB/fortran.c b/CROCO/croco-v1.3.1/AGRIF/LIB/fortran.c new file mode 100644 index 00000000..cee9b8ef --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/LIB/fortran.c @@ -0,0 +1,13086 @@ +/* A Bison parser, made by GNU Bison 2.7. */ + +/* Bison implementation for Yacc-like parsers in C + + Copyright (C) 1984, 1989-1990, 2000-2012 Free Software Foundation, Inc. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . */ + +/* As a special exception, you may create a larger work that contains + part or all of the Bison parser skeleton and distribute that work + under terms of your choice, so long as that work isn't itself a + parser generator using the skeleton or a modified version thereof + as a parser skeleton. Alternatively, if you modify or redistribute + the parser skeleton itself, you may (at your option) remove this + special exception, which will cause the skeleton and the resulting + Bison output files to be licensed under the GNU General Public + License without this special exception. + + This special exception was added by the Free Software Foundation in + version 2.2 of Bison. */ + +/* C LALR(1) parser skeleton written by Richard Stallman, by + simplifying the original so-called "semantic" parser. */ + +/* All symbols defined below should begin with yy or YY, to avoid + infringing on user name space. This should be done even for local + variables, as they might otherwise be expanded by user macros. + There are some unavoidable exceptions within include files to + define necessary library symbols; they are noted "INFRINGES ON + USER NAME SPACE" below. */ + +/* Identify Bison output. */ +#define YYBISON 1 + +/* Bison version. */ +#define YYBISON_VERSION "2.7" + +/* Skeleton name. */ +#define YYSKELETON_NAME "yacc.c" + +/* Pure parsers. */ +#define YYPURE 0 + +/* Push parsers. */ +#define YYPUSH 0 + +/* Pull parsers. */ +#define YYPULL 1 + + +/* Substitute the variable and function names. */ +#define yyparse fortran_parse +#define yylex fortran_lex +#define yyerror fortran_error +#define yylval fortran_lval +#define yychar fortran_char +#define yydebug fortran_debug +#define yynerrs fortran_nerrs + +/* Copy the first part of user declarations. */ +/* Line 371 of yacc.c */ +#line 36 "fortran.y" + +#define YYMAXDEPTH 1000 +#include +#include +#include +#include "decl.h" + +extern int line_num_input; + +char c_selectorname[LONG_M]; +char ligne[LONG_M]; +char truename[LONG_VNAME]; +char identcopy[LONG_VNAME]; +int c_selectorgiven=0; +listvar *curlistvar; +int in_select_case_stmt=0; +typedim c_selectordim; +listcouple *coupletmp; +int removeline=0; +int token_since_endofstmt = 0; +int increment_nbtokens = 1; +int in_complex_literal = 0; +int close_or_connect = 0; +int in_io_control_spec = 0; +long int my_position; +long int my_position_before; +int suborfun = 0; +int indeclaration = 0; +int endoffile = 0; +int in_inquire = 0; +int in_char_selector = 0; +int in_kind_selector =0; +int char_length_toreset = 0; + +typedim my_dim; + +listvar *test; + +char linebuf1[1024]; +char linebuf2[1024]; + +int fortran_error(const char *s) +{ + if (endoffile == 1) + { + endoffile = 0; + return 0; + } + printf("%s line %d, file %s culprit = |%s|\n", s, line_num_input, cur_filename, strcat(linebuf1, linebuf2)); + exit(1); +} + + +/* Line 371 of yacc.c */ +#line 129 "fortran.tab.c" + +# ifndef YY_NULL +# if defined __cplusplus && 201103L <= __cplusplus +# define YY_NULL nullptr +# else +# define YY_NULL 0 +# endif +# endif + +/* Enabling verbose error messages. */ +#ifdef YYERROR_VERBOSE +# undef YYERROR_VERBOSE +# define YYERROR_VERBOSE 1 +#else +# define YYERROR_VERBOSE 0 +#endif + + +/* Enabling traces. */ +#ifndef YYDEBUG +# define YYDEBUG 1 +#endif +#if YYDEBUG +extern int fortran_debug; +#endif + +/* Tokens. */ +#ifndef YYTOKENTYPE +# define YYTOKENTYPE + /* Put the tokens into the symbol table, so that GDB and other debuggers + know about them. */ + enum yytokentype { + TOK_NEQV = 258, + TOK_EQV = 259, + TOK_XOR = 260, + TOK_OR = 261, + TOK_AND = 262, + TOK_NOT = 263, + TOK_NE = 264, + TOK_EQ = 265, + TOK_GE = 266, + TOK_LE = 267, + TOK_GT = 268, + TOK_LT = 269, + TOK_DSLASH = 270, + TOK_SLASH = 271, + TOK_DASTER = 272, + TOK_SEMICOLON = 273, + TOK_PARAMETER = 274, + TOK_RESULT = 275, + TOK_ONLY = 276, + TOK_INCLUDE = 277, + TOK_SUBROUTINE = 278, + TOK_PROGRAM = 279, + TOK_FUNCTION = 280, + TOK_LABEL_FORMAT = 281, + TOK_LABEL_CONTINUE = 282, + TOK_LABEL_END_DO = 283, + TOK_MAX = 284, + TOK_TANH = 285, + TOK_COMMENT = 286, + TOK_WHERE = 287, + TOK_ELSEWHEREPAR = 288, + TOK_ELSEWHERE = 289, + TOK_ENDWHERE = 290, + TOK_MAXVAL = 291, + TOK_TRIM = 292, + TOK_NULL_PTR = 293, + TOK_SUM = 294, + TOK_SQRT = 295, + TOK_CASE = 296, + TOK_SELECTCASE = 297, + TOK_FILE = 298, + TOK_REC = 299, + TOK_NAME_EQ = 300, + TOK_IOLENGTH = 301, + TOK_ACCESS = 302, + TOK_ACTION = 303, + TOK_FORM = 304, + TOK_RECL = 305, + TOK_STATUS = 306, + TOK_UNIT = 307, + TOK_OPENED = 308, + TOK_FMT = 309, + TOK_NML = 310, + TOK_END = 311, + TOK_EOR = 312, + TOK_EOF = 313, + TOK_ERR = 314, + TOK_POSITION = 315, + TOK_IOSTAT = 316, + TOK_IOMSG = 317, + TOK_EXIST = 318, + TOK_MIN = 319, + TOK_FLOAT = 320, + TOK_EXP = 321, + TOK_LEN = 322, + TOK_COS = 323, + TOK_COSH = 324, + TOK_ACOS = 325, + TOK_NINT = 326, + TOK_CYCLE = 327, + TOK_SIN = 328, + TOK_SINH = 329, + TOK_ASIN = 330, + TOK_EQUIVALENCE = 331, + TOK_BACKSPACE = 332, + TOK_LOG = 333, + TOK_TAN = 334, + TOK_ATAN = 335, + TOK_RECURSIVE = 336, + TOK_ABS = 337, + TOK_MOD = 338, + TOK_SIGN = 339, + TOK_MINLOC = 340, + TOK_MAXLOC = 341, + TOK_EXIT = 342, + TOK_KIND = 343, + TOK_MOLD = 344, + TOK_SOURCE = 345, + TOK_ERRMSG = 346, + TOK_MINVAL = 347, + TOK_PUBLIC = 348, + TOK_PRIVATE = 349, + TOK_ALLOCATABLE = 350, + TOK_RETURN = 351, + TOK_THEN = 352, + TOK_ELSEIF = 353, + TOK_ELSE = 354, + TOK_ENDIF = 355, + TOK_PRINT = 356, + TOK_PLAINGOTO = 357, + TOK_LOGICALIF = 358, + TOK_LOGICALIF_PAR = 359, + TOK_PLAINDO = 360, + TOK_CONTAINS = 361, + TOK_ENDDO = 362, + TOK_MODULE = 363, + TOK_ENDMODULE = 364, + TOK_WHILE = 365, + TOK_CONCURRENT = 366, + TOK_ALLOCATE = 367, + TOK_OPEN = 368, + TOK_CLOSE = 369, + TOK_INQUIRE = 370, + TOK_WRITE_PAR = 371, + TOK_WRITE = 372, + TOK_FLUSH = 373, + TOK_READ_PAR = 374, + TOK_READ = 375, + TOK_REWIND = 376, + TOK_DEALLOCATE = 377, + TOK_NULLIFY = 378, + TOK_DIMENSION = 379, + TOK_ENDSELECT = 380, + TOK_EXTERNAL = 381, + TOK_INTENT = 382, + TOK_INTRINSIC = 383, + TOK_NAMELIST = 384, + TOK_DEFAULT = 385, + TOK_OPTIONAL = 386, + TOK_POINTER = 387, + TOK_CONTINUE = 388, + TOK_SAVE = 389, + TOK_TARGET = 390, + TOK_IMPLICIT = 391, + TOK_NONE = 392, + TOK_CALL = 393, + TOK_STAT = 394, + TOK_POINT_TO = 395, + TOK_COMMON = 396, + TOK_GLOBAL = 397, + TOK_LEFTAB = 398, + TOK_RIGHTAB = 399, + TOK_PAUSE = 400, + TOK_PROCEDURE = 401, + TOK_STOP = 402, + TOK_FOURDOTS = 403, + TOK_HEXA = 404, + TOK_ASSIGNTYPE = 405, + TOK_OUT = 406, + TOK_INOUT = 407, + TOK_IN = 408, + TOK_USE = 409, + TOK_EQUALEQUAL = 410, + TOK_SLASHEQUAL = 411, + TOK_INFEQUAL = 412, + TOK_SUPEQUAL = 413, + TOK_TRUE = 414, + TOK_FALSE = 415, + TOK_LABEL = 416, + TOK_LABEL_DJVIEW = 417, + TOK_PLAINDO_LABEL_DJVIEW = 418, + TOK_PLAINDO_LABEL = 419, + TOK_TYPE = 420, + TOK_TYPEPAR = 421, + TOK_ENDTYPE = 422, + TOK_COMMACOMPLEX = 423, + TOK_REAL = 424, + TOK_INTEGER = 425, + TOK_LOGICAL = 426, + TOK_DOUBLEPRECISION = 427, + TOK_ENDSUBROUTINE = 428, + TOK_ENDFUNCTION = 429, + TOK_ENDPROGRAM = 430, + TOK_ENDUNIT = 431, + TOK_CHARACTER = 432, + TOK_CHAR_CONSTANT = 433, + TOK_CHAR_CUT = 434, + TOK_DATA = 435, + TOK_CHAR_MESSAGE = 436, + TOK_CSTREAL = 437, + TOK_COMPLEX = 438, + TOK_DOUBLECOMPLEX = 439, + TOK_NAME = 440, + TOK_CSTINT = 441 + }; +#endif + + +#if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED +typedef union YYSTYPE +{ +/* Line 387 of yacc.c */ +#line 90 "fortran.y" + + char na[LONG_M]; + listdim *d; + listvar *l; + listcouple *lc; + listname *lnn; + typedim dim1; + variable *v; + + +/* Line 387 of yacc.c */ +#line 366 "fortran.tab.c" +} YYSTYPE; +# define YYSTYPE_IS_TRIVIAL 1 +# define yystype YYSTYPE /* obsolescent; will be withdrawn */ +# define YYSTYPE_IS_DECLARED 1 +#endif + +extern YYSTYPE fortran_lval; + +#ifdef YYPARSE_PARAM +#if defined __STDC__ || defined __cplusplus +int fortran_parse (void *YYPARSE_PARAM); +#else +int fortran_parse (); +#endif +#else /* ! YYPARSE_PARAM */ +#if defined __STDC__ || defined __cplusplus +int fortran_parse (void); +#else +int fortran_parse (); +#endif +#endif /* ! YYPARSE_PARAM */ + + + +/* Copy the second part of user declarations. */ + +/* Line 390 of yacc.c */ +#line 394 "fortran.tab.c" + +#ifdef short +# undef short +#endif + +#ifdef YYTYPE_UINT8 +typedef YYTYPE_UINT8 yytype_uint8; +#else +typedef unsigned char yytype_uint8; +#endif + +#ifdef YYTYPE_INT8 +typedef YYTYPE_INT8 yytype_int8; +#elif (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +typedef signed char yytype_int8; +#else +typedef short int yytype_int8; +#endif + +#ifdef YYTYPE_UINT16 +typedef YYTYPE_UINT16 yytype_uint16; +#else +typedef unsigned short int yytype_uint16; +#endif + +#ifdef YYTYPE_INT16 +typedef YYTYPE_INT16 yytype_int16; +#else +typedef short int yytype_int16; +#endif + +#ifndef YYSIZE_T +# ifdef __SIZE_TYPE__ +# define YYSIZE_T __SIZE_TYPE__ +# elif defined size_t +# define YYSIZE_T size_t +# elif ! defined YYSIZE_T && (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +# include /* INFRINGES ON USER NAME SPACE */ +# define YYSIZE_T size_t +# else +# define YYSIZE_T unsigned int +# endif +#endif + +#define YYSIZE_MAXIMUM ((YYSIZE_T) -1) + +#ifndef YY_ +# if defined YYENABLE_NLS && YYENABLE_NLS +# if ENABLE_NLS +# include /* INFRINGES ON USER NAME SPACE */ +# define YY_(Msgid) dgettext ("bison-runtime", Msgid) +# endif +# endif +# ifndef YY_ +# define YY_(Msgid) Msgid +# endif +#endif + +/* Suppress unused-variable warnings by "using" E. */ +#if ! defined lint || defined __GNUC__ +# define YYUSE(E) ((void) (E)) +#else +# define YYUSE(E) /* empty */ +#endif + +/* Identity function, used to suppress warnings about constant conditions. */ +#ifndef lint +# define YYID(N) (N) +#else +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +static int +YYID (int yyi) +#else +static int +YYID (yyi) + int yyi; +#endif +{ + return yyi; +} +#endif + +#if ! defined yyoverflow || YYERROR_VERBOSE + +/* The parser invokes alloca or malloc; define the necessary symbols. */ + +# ifdef YYSTACK_USE_ALLOCA +# if YYSTACK_USE_ALLOCA +# ifdef __GNUC__ +# define YYSTACK_ALLOC __builtin_alloca +# elif defined __BUILTIN_VA_ARG_INCR +# include /* INFRINGES ON USER NAME SPACE */ +# elif defined _AIX +# define YYSTACK_ALLOC __alloca +# elif defined _MSC_VER +# include /* INFRINGES ON USER NAME SPACE */ +# define alloca _alloca +# else +# define YYSTACK_ALLOC alloca +# if ! defined _ALLOCA_H && ! defined EXIT_SUCCESS && (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +# include /* INFRINGES ON USER NAME SPACE */ + /* Use EXIT_SUCCESS as a witness for stdlib.h. */ +# ifndef EXIT_SUCCESS +# define EXIT_SUCCESS 0 +# endif +# endif +# endif +# endif +# endif + +# ifdef YYSTACK_ALLOC + /* Pacify GCC's `empty if-body' warning. */ +# define YYSTACK_FREE(Ptr) do { /* empty */; } while (YYID (0)) +# ifndef YYSTACK_ALLOC_MAXIMUM + /* The OS might guarantee only one guard page at the bottom of the stack, + and a page size can be as small as 4096 bytes. So we cannot safely + invoke alloca (N) if N exceeds 4096. Use a slightly smaller number + to allow for a few compiler-allocated temporary stack slots. */ +# define YYSTACK_ALLOC_MAXIMUM 4032 /* reasonable circa 2006 */ +# endif +# else +# define YYSTACK_ALLOC YYMALLOC +# define YYSTACK_FREE YYFREE +# ifndef YYSTACK_ALLOC_MAXIMUM +# define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM +# endif +# if (defined __cplusplus && ! defined EXIT_SUCCESS \ + && ! ((defined YYMALLOC || defined malloc) \ + && (defined YYFREE || defined free))) +# include /* INFRINGES ON USER NAME SPACE */ +# ifndef EXIT_SUCCESS +# define EXIT_SUCCESS 0 +# endif +# endif +# ifndef YYMALLOC +# define YYMALLOC malloc +# if ! defined malloc && ! defined EXIT_SUCCESS && (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */ +# endif +# endif +# ifndef YYFREE +# define YYFREE free +# if ! defined free && ! defined EXIT_SUCCESS && (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +void free (void *); /* INFRINGES ON USER NAME SPACE */ +# endif +# endif +# endif +#endif /* ! defined yyoverflow || YYERROR_VERBOSE */ + + +#if (! defined yyoverflow \ + && (! defined __cplusplus \ + || (defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL))) + +/* A type that is properly aligned for any stack member. */ +union yyalloc +{ + yytype_int16 yyss_alloc; + YYSTYPE yyvs_alloc; +}; + +/* The size of the maximum gap between one aligned stack and the next. */ +# define YYSTACK_GAP_MAXIMUM (sizeof (union yyalloc) - 1) + +/* The size of an array large to enough to hold all stacks, each with + N elements. */ +# define YYSTACK_BYTES(N) \ + ((N) * (sizeof (yytype_int16) + sizeof (YYSTYPE)) \ + + YYSTACK_GAP_MAXIMUM) + +# define YYCOPY_NEEDED 1 + +/* Relocate STACK from its old location to the new one. The + local variables YYSIZE and YYSTACKSIZE give the old and new number of + elements in the stack, and YYPTR gives the new location of the + stack. Advance YYPTR to a properly aligned location for the next + stack. */ +# define YYSTACK_RELOCATE(Stack_alloc, Stack) \ + do \ + { \ + YYSIZE_T yynewbytes; \ + YYCOPY (&yyptr->Stack_alloc, Stack, yysize); \ + Stack = &yyptr->Stack_alloc; \ + yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \ + yyptr += yynewbytes / sizeof (*yyptr); \ + } \ + while (YYID (0)) + +#endif + +#if defined YYCOPY_NEEDED && YYCOPY_NEEDED +/* Copy COUNT objects from SRC to DST. The source and destination do + not overlap. */ +# ifndef YYCOPY +# if defined __GNUC__ && 1 < __GNUC__ +# define YYCOPY(Dst, Src, Count) \ + __builtin_memcpy (Dst, Src, (Count) * sizeof (*(Src))) +# else +# define YYCOPY(Dst, Src, Count) \ + do \ + { \ + YYSIZE_T yyi; \ + for (yyi = 0; yyi < (Count); yyi++) \ + (Dst)[yyi] = (Src)[yyi]; \ + } \ + while (YYID (0)) +# endif +# endif +#endif /* !YYCOPY_NEEDED */ + +/* YYFINAL -- State number of the termination state. */ +#define YYFINAL 2 +/* YYLAST -- Last index in YYTABLE. */ +#define YYLAST 4587 + +/* YYNTOKENS -- Number of terminals. */ +#define YYNTOKENS 203 +/* YYNNTS -- Number of nonterminals. */ +#define YYNNTS 523 +/* YYNRULES -- Number of rules. */ +#define YYNRULES 1069 +/* YYNRULES -- Number of states. */ +#define YYNSTATES 1729 + +/* YYTRANSLATE(YYLEX) -- Bison symbol number corresponding to YYLEX. */ +#define YYUNDEFTOK 2 +#define YYMAXUTOK 441 + +#define YYTRANSLATE(YYX) \ + ((unsigned int) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK) + +/* YYTRANSLATE[YYLEX] -- Bison symbol number corresponding to YYLEX. */ +static const yytype_uint8 yytranslate[] = +{ + 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 197, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 199, 2, 2, + 193, 194, 21, 19, 3, 20, 2, 198, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 4, 2, + 195, 5, 196, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 201, 2, 202, 2, 200, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 1, 2, 6, 7, + 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, + 18, 22, 23, 24, 25, 26, 27, 28, 29, 30, + 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, + 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, + 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, + 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, + 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, + 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, + 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, + 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, + 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, + 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, + 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, + 141, 142, 143, 144, 145, 146, 147, 148, 149, 150, + 151, 152, 153, 154, 155, 156, 157, 158, 159, 160, + 161, 162, 163, 164, 165, 166, 167, 168, 169, 170, + 171, 172, 173, 174, 175, 176, 177, 178, 179, 180, + 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, + 191, 192 +}; + +#if YYDEBUG +/* YYPRHS[YYN] -- Index of the first RHS symbol of rule number YYN in + YYRHS. */ +static const yytype_uint16 yyprhs[] = +{ + 0, 0, 3, 4, 7, 9, 11, 13, 16, 18, + 20, 24, 27, 29, 33, 37, 39, 43, 45, 46, + 48, 50, 52, 54, 56, 58, 59, 61, 63, 65, + 68, 71, 74, 76, 78, 81, 84, 87, 90, 93, + 96, 99, 102, 105, 109, 113, 116, 119, 122, 125, + 128, 131, 134, 137, 140, 143, 144, 146, 149, 152, + 155, 157, 159, 161, 163, 164, 166, 169, 170, 176, + 177, 184, 186, 187, 193, 198, 200, 203, 205, 209, + 211, 213, 217, 223, 228, 232, 235, 238, 240, 242, + 244, 246, 248, 250, 252, 254, 257, 260, 262, 265, + 267, 269, 270, 272, 273, 275, 278, 279, 281, 282, + 284, 286, 289, 291, 293, 295, 297, 299, 301, 303, + 305, 307, 309, 311, 313, 315, 316, 318, 321, 322, + 324, 326, 329, 331, 333, 334, 336, 340, 341, 343, + 345, 348, 350, 352, 354, 356, 358, 360, 362, 364, + 366, 368, 370, 372, 374, 376, 378, 380, 382, 384, + 386, 388, 390, 392, 394, 396, 398, 400, 403, 408, + 411, 413, 415, 417, 419, 421, 423, 425, 427, 429, + 431, 433, 435, 437, 439, 441, 443, 445, 447, 449, + 451, 453, 455, 456, 458, 460, 462, 463, 465, 467, + 469, 471, 473, 474, 477, 481, 485, 486, 490, 491, + 495, 496, 500, 501, 505, 506, 510, 511, 515, 516, + 518, 522, 528, 531, 533, 536, 538, 542, 544, 546, + 548, 551, 553, 557, 563, 565, 567, 569, 571, 573, + 575, 576, 579, 580, 582, 584, 594, 600, 606, 616, + 620, 626, 629, 633, 637, 639, 641, 643, 645, 647, + 649, 650, 655, 660, 668, 669, 672, 673, 676, 678, + 682, 684, 686, 690, 692, 695, 699, 700, 702, 704, + 707, 709, 714, 715, 717, 721, 723, 727, 729, 731, + 736, 738, 740, 744, 749, 750, 754, 756, 758, 759, + 761, 764, 767, 770, 772, 774, 779, 781, 785, 787, + 791, 795, 800, 802, 806, 808, 812, 814, 816, 818, + 822, 826, 828, 830, 832, 834, 838, 840, 842, 848, + 854, 862, 864, 865, 866, 873, 874, 877, 878, 880, + 883, 887, 889, 891, 892, 898, 900, 901, 907, 909, + 911, 913, 915, 917, 919, 921, 925, 930, 932, 934, + 935, 937, 940, 943, 946, 948, 950, 952, 953, 954, + 959, 961, 963, 965, 967, 969, 971, 975, 979, 981, + 983, 985, 987, 991, 993, 996, 998, 1002, 1004, 1008, + 1009, 1012, 1013, 1016, 1018, 1022, 1025, 1027, 1029, 1031, + 1032, 1037, 1038, 1041, 1043, 1047, 1049, 1051, 1052, 1058, + 1059, 1061, 1064, 1068, 1073, 1075, 1079, 1081, 1085, 1087, + 1089, 1099, 1111, 1113, 1117, 1119, 1121, 1123, 1125, 1128, + 1131, 1134, 1136, 1138, 1140, 1142, 1144, 1145, 1148, 1150, + 1152, 1154, 1156, 1158, 1160, 1162, 1164, 1166, 1167, 1168, + 1175, 1176, 1182, 1183, 1191, 1192, 1193, 1201, 1203, 1207, + 1211, 1212, 1213, 1220, 1221, 1223, 1224, 1226, 1228, 1232, + 1234, 1236, 1238, 1240, 1241, 1246, 1247, 1253, 1255, 1259, + 1264, 1266, 1270, 1272, 1276, 1284, 1285, 1292, 1294, 1298, + 1300, 1304, 1306, 1310, 1311, 1318, 1320, 1324, 1326, 1328, + 1330, 1331, 1332, 1340, 1341, 1343, 1345, 1349, 1350, 1352, + 1353, 1354, 1360, 1362, 1366, 1368, 1369, 1375, 1377, 1379, + 1381, 1383, 1385, 1387, 1389, 1391, 1393, 1395, 1397, 1399, + 1401, 1403, 1405, 1410, 1415, 1419, 1422, 1423, 1427, 1429, + 1430, 1436, 1438, 1440, 1442, 1444, 1449, 1450, 1452, 1456, + 1459, 1461, 1464, 1468, 1473, 1476, 1478, 1482, 1487, 1490, + 1492, 1495, 1499, 1504, 1507, 1508, 1510, 1511, 1512, 1521, + 1522, 1525, 1527, 1531, 1534, 1538, 1540, 1542, 1544, 1548, + 1551, 1553, 1555, 1556, 1560, 1562, 1566, 1569, 1570, 1573, + 1575, 1577, 1578, 1579, 1588, 1590, 1594, 1595, 1598, 1600, + 1604, 1607, 1611, 1613, 1615, 1617, 1619, 1623, 1625, 1627, + 1631, 1633, 1637, 1639, 1642, 1646, 1648, 1651, 1653, 1655, + 1657, 1659, 1661, 1663, 1667, 1669, 1671, 1675, 1677, 1679, + 1681, 1683, 1685, 1687, 1689, 1691, 1693, 1695, 1697, 1699, + 1701, 1704, 1706, 1710, 1712, 1716, 1718, 1722, 1724, 1726, + 1728, 1730, 1732, 1734, 1736, 1738, 1740, 1741, 1743, 1745, + 1747, 1749, 1751, 1753, 1755, 1757, 1762, 1768, 1774, 1782, + 1787, 1788, 1792, 1794, 1798, 1800, 1804, 1807, 1811, 1813, + 1815, 1819, 1821, 1823, 1825, 1831, 1837, 1838, 1841, 1842, + 1846, 1847, 1851, 1857, 1859, 1861, 1863, 1865, 1867, 1872, + 1878, 1881, 1885, 1888, 1892, 1893, 1895, 1896, 1899, 1901, + 1903, 1905, 1909, 1913, 1918, 1921, 1927, 1931, 1936, 1939, + 1945, 1949, 1954, 1957, 1963, 1967, 1974, 1983, 1989, 1993, + 1995, 1997, 1999, 2002, 2006, 2011, 2013, 2015, 2019, 2022, + 2024, 2026, 2028, 2030, 2032, 2034, 2036, 2039, 2044, 2046, + 2048, 2050, 2052, 2054, 2056, 2058, 2060, 2065, 2069, 2072, + 2076, 2080, 2083, 2084, 2086, 2090, 2096, 2097, 2099, 2102, + 2105, 2106, 2108, 2111, 2114, 2123, 2130, 2137, 2145, 2148, + 2152, 2155, 2159, 2165, 2169, 2170, 2172, 2175, 2178, 2179, + 2188, 2189, 2196, 2200, 2205, 2206, 2210, 2211, 2216, 2217, + 2222, 2224, 2226, 2230, 2232, 2235, 2238, 2242, 2244, 2247, + 2251, 2255, 2266, 2270, 2273, 2277, 2279, 2281, 2283, 2285, + 2287, 2289, 2291, 2292, 2293, 2301, 2303, 2307, 2309, 2312, + 2315, 2318, 2321, 2324, 2327, 2330, 2333, 2336, 2340, 2342, + 2344, 2345, 2353, 2355, 2359, 2361, 2364, 2367, 2370, 2374, + 2375, 2382, 2383, 2391, 2396, 2403, 2404, 2411, 2412, 2420, + 2425, 2432, 2434, 2438, 2440, 2442, 2445, 2447, 2449, 2452, + 2455, 2458, 2461, 2464, 2467, 2471, 2473, 2475, 2477, 2479, + 2483, 2485, 2487, 2489, 2493, 2495, 2497, 2503, 2505, 2509, + 2511, 2513, 2519, 2527, 2531, 2537, 2539, 2543, 2545, 2548, + 2551, 2554, 2557, 2561, 2567, 2569, 2573, 2575, 2578, 2581, + 2584, 2587, 2588, 2596, 2597, 2607, 2608, 2610, 2614, 2616, + 2619, 2622, 2625, 2628, 2631, 2634, 2637, 2641, 2644, 2647, + 2650, 2651, 2657, 2658, 2660, 2661, 2666, 2667, 2674, 2675, + 2677, 2678, 2680, 2683, 2684, 2686, 2688, 2691, 2693, 2695, + 2697, 2700, 2701, 2702, 2711, 2712, 2724, 2725, 2727, 2731, + 2732, 2734, 2740, 2741, 2743, 2744, 2746, 2747, 2752, 2753, + 2754, 2761, 2762, 2764, 2765, 2767, 2769, 2770, 2773, 2775, + 2779, 2783, 2785, 2789, 2791, 2793, 2795, 2797, 2799, 2803, + 2808, 2810, 2814, 2816, 2821, 2823, 2827, 2829, 2833, 2834, + 2840, 2841, 2845, 2846, 2852, 2853, 2854, 2862, 2863, 2868, + 2870, 2872, 2874, 2876, 2880, 2882, 2886, 2888, 2890, 2892, + 2893, 2895, 2897, 2900, 2902, 2904, 2906, 2912, 2913, 2914, + 2925, 2927, 2929, 2930, 2932, 2937, 2938, 2946, 2947, 2949, + 2955, 2956, 2963, 2965, 2972, 2973, 2974, 2976, 2977, 2978, + 2983, 2984, 2986, 2988, 2992, 2994, 2996, 3000, 3005, 3006, + 3011, 3013, 3015, 3019, 3023, 3025, 3029, 3031, 3032, 3034 +}; + +/* YYRHS -- A `-1'-separated list of the rules' RHS. */ +static const yytype_int16 yyrhs[] = +{ + 204, 0, -1, -1, 204, 205, -1, 206, -1, 207, + -1, 1, -1, 197, 209, -1, 24, -1, 64, -1, + 206, 197, 209, -1, 206, 24, -1, 208, -1, 207, + 24, 197, -1, 207, 24, 208, -1, 210, -1, 28, + 212, 209, -1, 37, -1, -1, 657, -1, 211, -1, + 637, -1, 696, -1, 707, -1, 184, -1, -1, 3, + -1, 219, -1, 232, -1, 502, 216, -1, 215, 502, + -1, 11, 502, -1, 19, -1, 20, -1, 19, 502, + -1, 20, 502, -1, 21, 502, -1, 23, 502, -1, + 13, 502, -1, 7, 502, -1, 16, 502, -1, 196, + 502, -1, 195, 502, -1, 196, 5, 502, -1, 195, + 5, 502, -1, 17, 502, -1, 14, 502, -1, 15, + 502, -1, 12, 502, -1, 6, 502, -1, 8, 502, + -1, 9, 502, -1, 10, 502, -1, 22, 217, -1, + 5, 218, -1, -1, 502, -1, 5, 502, -1, 22, + 502, -1, 5, 502, -1, 502, -1, 231, -1, 226, + -1, 221, -1, -1, 224, -1, 224, 444, -1, -1, + 226, 193, 222, 227, 194, -1, -1, 226, 193, 223, + 227, 194, 444, -1, 109, -1, -1, 231, 193, 225, + 227, 194, -1, 219, 199, 724, 219, -1, 220, -1, + 220, 228, -1, 229, -1, 228, 3, 229, -1, 502, + -1, 230, -1, 502, 4, 502, -1, 502, 4, 502, + 4, 502, -1, 4, 502, 4, 502, -1, 4, 4, + 502, -1, 4, 502, -1, 502, 4, -1, 4, -1, + 191, -1, 165, -1, 166, -1, 44, -1, 192, -1, + 188, -1, 155, -1, 232, 191, -1, 233, 234, -1, + 184, -1, 233, 184, -1, 187, -1, 185, -1, -1, + 444, -1, -1, 502, -1, 237, 238, -1, -1, 650, + -1, -1, 239, -1, 240, -1, 239, 240, -1, 290, + -1, 392, -1, 636, -1, 406, -1, 251, -1, 330, + -1, 514, -1, 515, -1, 540, -1, 588, -1, 719, + -1, 611, -1, 560, -1, -1, 242, -1, 252, 243, + -1, -1, 244, -1, 245, -1, 244, 245, -1, 252, + -1, 636, -1, -1, 247, -1, 112, 206, 248, -1, + -1, 249, -1, 250, -1, 249, 250, -1, 696, -1, + 707, -1, 364, -1, 422, -1, 369, -1, 386, -1, + 416, -1, 674, -1, 677, -1, 412, -1, 397, -1, + 253, -1, 540, -1, 570, -1, 560, -1, 526, -1, + 458, -1, 514, -1, 682, -1, 601, -1, 588, -1, + 559, -1, 475, -1, 586, -1, 585, -1, 627, -1, + 78, 235, -1, 129, 193, 725, 194, -1, 115, 722, + -1, 569, -1, 630, -1, 594, -1, 515, -1, 611, + -1, 605, -1, 719, -1, 624, -1, 589, -1, 525, + -1, 608, -1, 587, -1, 231, -1, 256, -1, 257, + -1, 258, -1, 276, -1, 279, -1, 289, -1, 280, + -1, 288, -1, 231, -1, -1, 260, -1, 167, -1, + 192, -1, -1, 262, -1, 168, -1, 507, -1, 21, + -1, 4, -1, -1, 265, 266, -1, 172, 266, 194, + -1, 172, 314, 194, -1, -1, 176, 267, 273, -1, + -1, 175, 268, 273, -1, -1, 178, 269, 273, -1, + -1, 189, 270, 273, -1, -1, 183, 271, 284, -1, + -1, 177, 272, 273, -1, -1, 274, -1, 193, 512, + 194, -1, 193, 94, 5, 512, 194, -1, 21, 192, + -1, 276, -1, 489, 276, -1, 192, -1, 192, 200, + 277, -1, 192, -1, 191, -1, 279, -1, 489, 279, + -1, 188, -1, 188, 200, 277, -1, 193, 281, 174, + 282, 194, -1, 275, -1, 278, -1, 231, -1, 275, + -1, 278, -1, 258, -1, -1, 21, 287, -1, -1, + 285, -1, 286, -1, 193, 73, 5, 263, 3, 94, + 5, 512, 194, -1, 193, 263, 3, 512, 194, -1, + 193, 94, 5, 512, 194, -1, 193, 94, 5, 512, + 3, 73, 5, 263, 194, -1, 193, 263, 194, -1, + 193, 73, 5, 263, 194, -1, 21, 287, -1, 21, + 287, 3, -1, 193, 263, 194, -1, 276, -1, 184, + -1, 187, -1, 185, -1, 165, -1, 166, -1, -1, + 292, 291, 300, 299, -1, 171, 293, 191, 206, -1, + 171, 294, 191, 193, 297, 194, 206, -1, -1, 294, + 154, -1, -1, 3, 295, -1, 296, -1, 295, 3, + 296, -1, 346, -1, 298, -1, 297, 3, 298, -1, + 191, -1, 173, 206, -1, 173, 191, 206, -1, -1, + 301, -1, 302, -1, 301, 302, -1, 303, -1, 264, + 304, 307, 206, -1, -1, 154, -1, 3, 305, 154, + -1, 306, -1, 305, 3, 306, -1, 346, -1, 101, + -1, 130, 193, 310, 194, -1, 138, -1, 308, -1, + 307, 3, 308, -1, 231, 309, 283, 311, -1, -1, + 193, 310, 194, -1, 350, -1, 356, -1, -1, 312, + -1, 5, 509, -1, 146, 345, -1, 146, 313, -1, + 433, -1, 231, -1, 231, 193, 315, 194, -1, 316, + -1, 315, 3, 316, -1, 263, -1, 254, 5, 263, + -1, 314, 193, 194, -1, 314, 193, 318, 194, -1, + 319, -1, 318, 3, 319, -1, 320, -1, 254, 5, + 320, -1, 502, -1, 521, -1, 524, -1, 149, 322, + 150, -1, 323, 322, 324, -1, 325, -1, 201, -1, + 202, -1, 326, -1, 325, 3, 326, -1, 502, -1, + 327, -1, 193, 325, 3, 328, 194, -1, 329, 5, + 507, 3, 507, -1, 329, 5, 507, 3, 507, 3, + 507, -1, 546, -1, -1, -1, 331, 264, 333, 339, + 332, 206, -1, -1, 334, 154, -1, -1, 335, -1, + 3, 336, -1, 335, 3, 336, -1, 346, -1, 101, + -1, -1, 130, 193, 337, 349, 194, -1, 132, -1, + -1, 133, 193, 338, 363, 194, -1, 134, -1, 137, + -1, 25, -1, 138, -1, 140, -1, 141, -1, 340, + -1, 339, 3, 340, -1, 342, 347, 283, 343, -1, + 231, -1, 191, -1, -1, 344, -1, 5, 509, -1, + 146, 345, -1, 146, 313, -1, 680, -1, 99, -1, + 100, -1, -1, -1, 193, 348, 349, 194, -1, 350, + -1, 354, -1, 356, -1, 358, -1, 361, -1, 351, + -1, 350, 3, 351, -1, 352, 4, 353, -1, 353, + -1, 508, -1, 508, -1, 355, -1, 354, 3, 355, + -1, 4, -1, 352, 4, -1, 357, -1, 356, 3, + 357, -1, 4, -1, 359, 360, 21, -1, -1, 350, + 3, -1, -1, 352, 4, -1, 362, -1, 361, 3, + 362, -1, 360, 21, -1, 159, -1, 157, -1, 158, + -1, -1, 346, 366, 365, 206, -1, -1, 400, 367, + -1, 368, -1, 367, 3, 368, -1, 191, -1, 673, + -1, -1, 186, 373, 371, 370, 206, -1, -1, 372, + -1, 427, 373, -1, 372, 427, 373, -1, 374, 22, + 375, 22, -1, 376, -1, 374, 3, 376, -1, 381, + -1, 375, 3, 381, -1, 435, -1, 377, -1, 193, + 378, 3, 380, 5, 512, 3, 512, 194, -1, 193, + 378, 3, 380, 5, 512, 3, 512, 3, 512, 194, + -1, 379, -1, 378, 3, 379, -1, 452, -1, 450, + -1, 377, -1, 546, -1, 384, 382, -1, 276, 382, + -1, 288, 382, -1, 275, -1, 278, -1, 345, -1, + 313, -1, 317, -1, -1, 21, 383, -1, 255, -1, + 384, -1, 275, -1, 278, -1, 345, -1, 313, -1, + 317, -1, 385, -1, 433, -1, -1, -1, 387, 130, + 400, 389, 388, 206, -1, -1, 191, 193, 390, 349, + 194, -1, -1, 389, 3, 191, 193, 391, 349, 194, + -1, -1, -1, 25, 393, 193, 395, 194, 394, 206, + -1, 396, -1, 395, 3, 396, -1, 191, 5, 509, + -1, -1, -1, 398, 140, 400, 401, 399, 206, -1, + -1, 154, -1, -1, 402, -1, 403, -1, 402, 3, + 403, -1, 341, -1, 404, -1, 426, -1, 231, -1, + -1, 405, 142, 408, 206, -1, -1, 405, 142, 143, + 407, 206, -1, 409, -1, 408, 3, 409, -1, 264, + 193, 410, 194, -1, 411, -1, 410, 3, 411, -1, + 191, -1, 191, 20, 191, -1, 135, 22, 191, 22, + 414, 413, 206, -1, -1, 413, 427, 22, 191, 22, + 414, -1, 415, -1, 414, 3, 415, -1, 436, -1, + 82, 417, 206, -1, 418, -1, 417, 3, 418, -1, + -1, 193, 419, 421, 3, 420, 194, -1, 421, -1, + 420, 3, 421, -1, 436, -1, 452, -1, 444, -1, + -1, -1, 147, 423, 425, 430, 428, 424, 206, -1, + -1, 426, -1, 18, -1, 22, 191, 22, -1, -1, + 3, -1, -1, -1, 428, 427, 426, 429, 430, -1, + 431, -1, 430, 3, 431, -1, 191, -1, -1, 191, + 193, 432, 349, 194, -1, 452, -1, 453, -1, 451, + -1, 444, -1, 435, -1, 433, -1, 231, -1, 438, + -1, 435, -1, 435, -1, 441, -1, 435, -1, 443, + -1, 435, -1, 446, -1, 446, 193, 445, 194, -1, + 288, 193, 445, 194, -1, 506, 4, 506, -1, 448, + 447, -1, -1, 447, 199, 448, -1, 231, -1, -1, + 231, 193, 449, 454, 194, -1, 451, -1, 446, -1, + 446, -1, 446, -1, 446, 193, 445, 194, -1, -1, + 455, -1, 454, 3, 455, -1, 502, 456, -1, 4, + -1, 4, 502, -1, 4, 4, 502, -1, 4, 502, + 4, 502, -1, 154, 502, -1, 457, -1, 231, 5, + 502, -1, 231, 5, 21, 260, -1, 21, 260, -1, + 4, -1, 4, 502, -1, 4, 4, 502, -1, 4, + 502, 4, 502, -1, 154, 502, -1, -1, 505, -1, + -1, -1, 118, 193, 459, 466, 461, 194, 460, 206, + -1, -1, 3, 462, -1, 463, -1, 462, 3, 463, + -1, 97, 465, -1, 145, 5, 464, -1, 442, -1, + 440, -1, 467, -1, 466, 3, 467, -1, 468, 469, + -1, 436, -1, 451, -1, -1, 193, 470, 194, -1, + 471, -1, 470, 3, 471, -1, 472, 474, -1, -1, + 473, 4, -1, 507, -1, 507, -1, -1, -1, 128, + 193, 476, 478, 479, 194, 477, 206, -1, 468, -1, + 478, 3, 468, -1, -1, 3, 480, -1, 481, -1, + 480, 3, 481, -1, 97, 465, -1, 145, 5, 464, + -1, 433, -1, 257, -1, 321, -1, 680, -1, 193, + 502, 194, -1, 482, -1, 483, -1, 483, 487, 484, + -1, 484, -1, 485, 488, 484, -1, 485, -1, 489, + 485, -1, 486, 489, 485, -1, 275, -1, 486, 275, + -1, 23, -1, 21, -1, 22, -1, 19, -1, 20, + -1, 486, -1, 490, 491, 486, -1, 18, -1, 490, + -1, 490, 493, 490, -1, 13, -1, 12, -1, 17, + -1, 15, -1, 16, -1, 14, -1, 161, -1, 162, + -1, 195, -1, 163, -1, 196, -1, 164, -1, 492, + -1, 498, 492, -1, 494, -1, 495, 499, 494, -1, + 495, -1, 496, 500, 495, -1, 496, -1, 497, 501, + 496, -1, 11, -1, 10, -1, 9, -1, 7, -1, + 6, -1, 497, -1, 504, -1, 502, -1, 502, -1, + -1, 507, -1, 505, -1, 507, -1, 502, -1, 511, + -1, 504, -1, 513, -1, 505, -1, 435, 5, 502, + 206, -1, 260, 435, 5, 502, 206, -1, 433, 516, + 146, 521, 206, -1, 433, 193, 518, 194, 146, 521, + 206, -1, 433, 146, 524, 206, -1, -1, 193, 517, + 194, -1, 519, -1, 517, 3, 519, -1, 520, -1, + 518, 3, 520, -1, 473, 4, -1, 473, 4, 474, + -1, 435, -1, 191, -1, 434, 199, 522, -1, 502, + -1, 522, -1, 523, -1, 38, 193, 533, 194, 532, + -1, 530, 527, 528, 529, 536, -1, -1, 527, 531, + -1, -1, 528, 534, 527, -1, -1, 529, 535, 527, + -1, 38, 193, 533, 194, 206, -1, 532, -1, 525, + -1, 526, -1, 514, -1, 502, -1, 39, 533, 194, + 206, -1, 39, 533, 194, 191, 206, -1, 40, 206, + -1, 40, 191, 206, -1, 41, 206, -1, 41, 191, + 206, -1, -1, 539, -1, -1, 539, 245, -1, 541, + -1, 550, -1, 541, -1, 542, 547, 548, -1, 544, + 547, 548, -1, 191, 4, 170, 206, -1, 170, 206, + -1, 191, 4, 170, 545, 206, -1, 170, 545, 206, + -1, 191, 4, 169, 206, -1, 169, 206, -1, 191, + 4, 169, 545, 206, -1, 169, 545, 206, -1, 191, + 4, 111, 206, -1, 111, 206, -1, 191, 4, 111, + 545, 206, -1, 111, 545, 206, -1, 213, 546, 5, + 502, 3, 502, -1, 213, 546, 5, 502, 3, 502, + 3, 502, -1, 213, 116, 193, 502, 194, -1, 213, + 117, 537, -1, 231, -1, 538, -1, 549, -1, 262, + 588, -1, 261, 113, 206, -1, 261, 113, 191, 206, + -1, 551, -1, 554, -1, 542, 547, 552, -1, 262, + 553, -1, 458, -1, 514, -1, 682, -1, 601, -1, + 475, -1, 627, -1, 586, -1, 127, 723, -1, 129, + 193, 725, 194, -1, 569, -1, 630, -1, 594, -1, + 611, -1, 605, -1, 624, -1, 525, -1, 608, -1, + 542, 547, 555, 556, -1, 542, 547, 556, -1, 543, + 547, -1, 555, 543, 547, -1, 543, 547, 557, -1, + 262, 253, -1, -1, 191, -1, 78, 558, 206, -1, + 565, 538, 561, 563, 568, -1, -1, 562, -1, 561, + 562, -1, 566, 538, -1, -1, 564, -1, 563, 562, + -1, 567, 538, -1, 259, 191, 4, 110, 502, 194, + 103, 206, -1, 259, 110, 502, 194, 103, 206, -1, + 104, 193, 502, 194, 103, 206, -1, 104, 193, 502, + 194, 103, 191, 206, -1, 105, 206, -1, 105, 191, + 206, -1, 106, 206, -1, 106, 191, 206, -1, 259, + 110, 502, 194, 253, -1, 573, 571, 577, -1, -1, + 572, -1, 571, 572, -1, 576, 538, -1, -1, 191, + 4, 48, 193, 502, 194, 574, 206, -1, -1, 48, + 193, 502, 194, 575, 206, -1, 47, 580, 206, -1, + 47, 580, 191, 206, -1, -1, 131, 578, 206, -1, + -1, 131, 191, 579, 206, -1, -1, 193, 581, 582, + 194, -1, 136, -1, 583, -1, 582, 3, 583, -1, + 584, -1, 584, 4, -1, 4, 584, -1, 584, 4, + 584, -1, 502, -1, 93, 206, -1, 93, 191, 206, + -1, 108, 260, 206, -1, 259, 110, 502, 194, 260, + 3, 260, 3, 260, 206, -1, 259, 139, 206, -1, + 153, 206, -1, 153, 590, 206, -1, 510, -1, 512, + -1, 592, -1, 21, -1, 593, -1, 507, -1, 439, + -1, -1, -1, 119, 193, 595, 597, 194, 596, 206, + -1, 598, -1, 597, 3, 598, -1, 592, -1, 58, + 592, -1, 53, 503, -1, 54, 503, -1, 65, 260, + -1, 49, 599, -1, 55, 503, -1, 67, 442, -1, + 66, 503, -1, 56, 507, -1, 57, 5, 503, -1, + 503, -1, 440, -1, -1, 259, 120, 193, 602, 603, + 194, 206, -1, 604, -1, 603, 3, 604, -1, 592, + -1, 58, 592, -1, 67, 442, -1, 65, 260, -1, + 57, 5, 503, -1, -1, 259, 125, 612, 194, 606, + 206, -1, -1, 259, 125, 612, 194, 616, 607, 206, + -1, 259, 126, 615, 206, -1, 259, 126, 615, 3, + 616, 206, -1, -1, 259, 122, 612, 194, 609, 206, + -1, -1, 259, 122, 612, 194, 618, 610, 206, -1, + 259, 107, 615, 206, -1, 259, 107, 615, 3, 618, + 206, -1, 614, -1, 612, 3, 614, -1, 191, -1, + 591, -1, 58, 591, -1, 615, -1, 613, -1, 61, + 613, -1, 60, 615, -1, 62, 260, -1, 63, 260, + -1, 65, 260, -1, 67, 442, -1, 50, 5, 507, + -1, 504, -1, 260, -1, 21, -1, 617, -1, 616, + 3, 617, -1, 435, -1, 620, -1, 619, -1, 618, + 3, 619, -1, 502, -1, 620, -1, 193, 621, 3, + 623, 194, -1, 622, -1, 621, 3, 622, -1, 617, + -1, 619, -1, 546, 5, 507, 3, 507, -1, 546, + 5, 507, 3, 507, 3, 507, -1, 127, 592, 206, + -1, 127, 193, 625, 194, 206, -1, 626, -1, 625, + 3, 626, -1, 592, -1, 58, 592, -1, 68, 600, + -1, 67, 442, -1, 65, 260, -1, 124, 592, 206, + -1, 124, 193, 628, 194, 206, -1, 629, -1, 628, + 3, 629, -1, 592, -1, 58, 592, -1, 67, 442, + -1, 68, 600, -1, 65, 260, -1, -1, 121, 633, + 193, 634, 194, 631, 206, -1, -1, 121, 633, 193, + 52, 442, 194, 618, 632, 206, -1, -1, 635, -1, + 634, 3, 635, -1, 592, -1, 58, 592, -1, 49, + 599, -1, 53, 440, -1, 54, 440, -1, 65, 260, + -1, 69, 437, -1, 67, 442, -1, 51, 5, 440, + -1, 59, 437, -1, 56, 442, -1, 32, 206, -1, + -1, 640, 658, 639, 638, 642, -1, -1, 646, -1, + -1, 114, 191, 641, 206, -1, -1, 405, 182, 644, + 645, 643, 206, -1, -1, 114, -1, -1, 191, -1, + 720, 647, -1, -1, 648, -1, 649, -1, 648, 649, + -1, 696, -1, 707, -1, 652, -1, 650, 652, -1, + -1, -1, 405, 160, 651, 655, 191, 667, 653, 206, + -1, -1, 405, 160, 651, 655, 191, 3, 27, 4, + 656, 654, 206, -1, -1, 154, -1, 3, 666, 154, + -1, -1, 670, -1, 659, 658, 241, 246, 661, -1, + -1, 236, -1, -1, 242, -1, -1, 30, 191, 660, + 206, -1, -1, -1, 662, 182, 664, 665, 663, 206, + -1, -1, 30, -1, -1, 191, -1, 134, -1, -1, + 3, 668, -1, 669, -1, 668, 3, 669, -1, 191, + 146, 191, -1, 671, -1, 670, 3, 671, -1, 673, + -1, 672, -1, 669, -1, 191, -1, 191, -1, 132, + 675, 206, -1, 132, 154, 675, 206, -1, 676, -1, + 675, 3, 676, -1, 191, -1, 134, 400, 678, 206, + -1, 679, -1, 678, 3, 679, -1, 191, -1, 689, + 193, 194, -1, -1, 689, 193, 681, 690, 194, -1, + -1, 687, 683, 206, -1, -1, 687, 193, 194, 684, + 206, -1, -1, -1, 687, 193, 685, 690, 194, 686, + 206, -1, -1, 259, 144, 688, 689, -1, 231, -1, + 124, -1, 175, -1, 691, -1, 690, 3, 691, -1, + 692, -1, 254, 5, 692, -1, 502, -1, 435, -1, + 231, -1, -1, 694, -1, 695, -1, 694, 695, -1, + 264, -1, 114, -1, 87, -1, 697, 658, 241, 246, + 704, -1, -1, -1, 693, 31, 700, 193, 698, 716, + 194, 702, 699, 206, -1, 191, -1, 191, -1, -1, + 703, -1, 26, 193, 191, 194, -1, -1, 405, 182, + 706, 645, 712, 705, 206, -1, -1, 31, -1, 708, + 658, 241, 246, 711, -1, -1, 693, 29, 710, 714, + 709, 206, -1, 191, -1, 405, 182, 713, 645, 712, + 206, -1, -1, -1, 29, -1, -1, -1, 193, 715, + 716, 194, -1, -1, 717, -1, 718, -1, 717, 3, + 718, -1, 701, -1, 21, -1, 259, 102, 206, -1, + 259, 102, 507, 206, -1, -1, 259, 112, 721, 206, + -1, 197, -1, 191, -1, 193, 231, 194, -1, 193, + 192, 194, -1, 192, -1, 193, 214, 194, -1, 191, + -1, -1, 231, -1, 725, 3, 231, -1 +}; + +/* YYRLINE[YYN] -- source line where rule number YYN was defined. */ +static const yytype_uint16 yyrline[] = +{ + 0, 513, 513, 514, 516, 517, 518, 520, 522, 523, + 524, 525, 528, 529, 530, 532, 533, 541, 559, 563, + 564, 565, 569, 570, 583, 851, 852, 1103, 1104, 1105, + 1106, 1107, 1109, 1110, 1114, 1115, 1116, 1117, 1118, 1119, + 1120, 1121, 1122, 1123, 1124, 1125, 1126, 1127, 1128, 1129, + 1130, 1131, 1132, 1133, 1134, 1136, 1137, 1138, 1139, 1142, + 1143, 1146, 1147, 1148, 1152, 1163, 1164, 1165, 1165, 1166, + 1166, 1168, 1169, 1169, 1178, 1190, 1191, 1194, 1195, 1198, + 1199, 1202, 1203, 1204, 1205, 1206, 1207, 1208, 1210, 1257, + 1258, 1259, 1260, 1261, 1262, 1263, 1265, 1268, 1269, 1270, + 1271, 1273, 1274, 1284, 1285, 1337, 1340, 1341, 1366, 1367, + 1371, 1372, 1385, 1386, 1387, 1388, 1389, 1390, 1391, 1392, + 1393, 1394, 1395, 1396, 1397, 1400, 1401, 1405, 1408, 1409, + 1413, 1414, 1418, 1419, 1422, 1423, 1427, 1431, 1432, 1435, + 1436, 1440, 1441, 1445, 1446, 1447, 1448, 1449, 1450, 1451, + 1452, 1453, 1458, 1459, 1460, 1461, 1462, 1470, 1471, 1472, + 1473, 1474, 1475, 1476, 1477, 1478, 1479, 1480, 1481, 1482, + 1504, 1505, 1506, 1507, 1508, 1509, 1510, 1511, 1512, 1513, + 1514, 1515, 1519, 1522, 1527, 1528, 1532, 1533, 1534, 1535, + 1537, 1541, 1560, 1561, 1565, 1566, 1570, 1571, 1575, 1579, + 1580, 1581, 1592, 1592, 1594, 1595, 1600, 1600, 1602, 1602, + 1604, 1604, 1606, 1606, 1608, 1608, 1610, 1610, 1615, 1616, + 1622, 1624, 1626, 1633, 1634, 1639, 1640, 1645, 1646, 1662, + 1663, 1668, 1669, 1676, 1682, 1683, 1684, 1688, 1689, 1690, + 1693, 1694, 1699, 1700, 1705, 1706, 1707, 1708, 1709, 1713, + 1715, 1717, 1718, 1722, 1724, 1729, 1730, 1731, 1735, 1736, + 1740, 1740, 1745, 1746, 1749, 1750, 1753, 1754, 1757, 1758, + 1762, 1765, 1766, 1769, 1773, 1774, 1777, 1778, 1782, 1783, + 1787, 1791, 1794, 1795, 1796, 1799, 1800, 1804, 1805, 1806, + 1807, 1810, 1811, 1815, 1838, 1839, 1843, 1844, 1847, 1848, + 1852, 1853, 1854, 1858, 1863, 1865, 1868, 1869, 1873, 1874, + 1878, 1879, 1882, 1883, 1887, 1888, 1892, 1893, 1894, 1898, + 1900, 1915, 1919, 1923, 1927, 1928, 1933, 1934, 1938, 1943, + 1945, 1950, 1954, 1955, 1954, 2022, 2023, 2026, 2027, 2031, + 2032, 2036, 2037, 2039, 2039, 2041, 2043, 2043, 2045, 2046, + 2048, 2050, 2052, 2054, 2059, 2061, 2066, 2100, 2103, 2106, + 2107, 2111, 2117, 2123, 2132, 2136, 2138, 2143, 2144, 2144, + 2149, 2151, 2153, 2155, 2157, 2161, 2167, 2176, 2178, 2183, + 2188, 2192, 2198, 2207, 2209, 2214, 2220, 2229, 2234, 2257, + 2258, 2277, 2278, 2282, 2283, 2287, 2291, 2293, 2295, 2301, + 2300, 2319, 2320, 2324, 2326, 2331, 2332, 2337, 2336, 2351, + 2352, 2355, 2356, 2360, 2370, 2372, 2378, 2380, 2385, 2386, + 2390, 2396, 2403, 2405, 2410, 2411, 2415, 2419, 2424, 2426, + 2428, 2430, 2431, 2432, 2433, 2434, 2438, 2439, 2455, 2456, + 2457, 2458, 2459, 2460, 2461, 2467, 2475, 2480, 2482, 2480, + 2527, 2527, 2536, 2536, 2549, 2550, 2549, 2569, 2571, 2576, + 2593, 2594, 2593, 2601, 2602, 2605, 2606, 2609, 2610, 2614, + 2616, 2617, 2621, 2625, 2629, 2631, 2630, 2642, 2643, 2647, + 2650, 2651, 2655, 2656, 2660, 2663, 2664, 2666, 2667, 2671, + 2675, 2678, 2679, 2683, 2683, 2686, 2687, 2691, 2692, 2693, + 2698, 2699, 2698, 2708, 2709, 2717, 2723, 2731, 2732, 2735, + 2737, 2736, 2746, 2748, 2756, 2762, 2762, 2771, 2772, 2773, + 2774, 2783, 2786, 2799, 2802, 2806, 2810, 2813, 2817, 2820, + 2823, 2827, 2828, 2830, 2845, 2850, 2855, 2856, 2861, 2863, + 2863, 2875, 2879, 2884, 2889, 2891, 2898, 2899, 2901, 2923, + 2925, 2927, 2929, 2931, 2933, 2935, 2936, 2938, 2940, 2944, + 2946, 2948, 2950, 2952, 2955, 2969, 2973, 2974, 2973, 2982, + 2983, 2987, 2988, 2992, 2993, 2997, 3001, 3005, 3006, 3010, + 3014, 3015, 3018, 3019, 3023, 3024, 3028, 3031, 3032, 3036, + 3040, 3044, 3045, 3044, 3050, 3051, 3054, 3055, 3059, 3060, + 3064, 3065, 3074, 3084, 3085, 3086, 3087, 3092, 3097, 3098, + 3102, 3103, 3110, 3111, 3113, 3115, 3116, 3121, 3125, 3127, + 3131, 3133, 3138, 3139, 3144, 3147, 3148, 3153, 3154, 3155, + 3156, 3157, 3158, 3159, 3160, 3161, 3163, 3164, 3166, 3171, + 3172, 3178, 3179, 3185, 3186, 3191, 3192, 3197, 3201, 3205, + 3209, 3210, 3214, 3217, 3221, 3225, 3229, 3230, 3233, 3237, + 3244, 3248, 3252, 3255, 3259, 3265, 3266, 3278, 3279, 3280, + 3288, 3289, 3293, 3294, 3298, 3299, 3303, 3307, 3311, 3314, + 3323, 3327, 3328, 3329, 3333, 3337, 3340, 3341, 3344, 3345, + 3348, 3349, 3353, 3357, 3358, 3359, 3363, 3367, 3371, 3372, + 3376, 3377, 3382, 3383, 3387, 3391, 3394, 3395, 3400, 3401, + 3405, 3410, 3411, 3422, 3423, 3424, 3425, 3428, 3429, 3430, + 3431, 3435, 3436, 3437, 3438, 3443, 3444, 3445, 3446, 3450, + 3454, 3463, 3464, 3468, 3469, 3480, 3481, 3487, 3497, 3502, + 3503, 3504, 3505, 3506, 3507, 3508, 3509, 3510, 3511, 3512, + 3513, 3514, 3515, 3516, 3517, 3518, 3528, 3529, 3532, 3533, + 3544, 3549, 3552, 3553, 3557, 3561, 3564, 3565, 3566, 3569, + 3572, 3573, 3574, 3577, 3581, 3582, 3586, 3587, 3591, 3592, + 3596, 3597, 3601, 3605, 3608, 3609, 3610, 3613, 3617, 3617, + 3618, 3618, 3622, 3623, 3627, 3627, 3628, 3628, 3633, 3633, + 3634, 3638, 3639, 3644, 3645, 3646, 3647, 3651, 3655, 3656, + 3660, 3664, 3668, 3672, 3673, 3677, 3678, 3682, 3683, 3684, + 3688, 3692, 3696, 3696, 3696, 3699, 3700, 3704, 3705, 3706, + 3707, 3708, 3709, 3710, 3711, 3712, 3713, 3714, 3718, 3722, + 3726, 3726, 3730, 3731, 3735, 3736, 3737, 3738, 3739, 3744, + 3743, 3749, 3748, 3753, 3754, 3759, 3758, 3764, 3763, 3771, + 3772, 3774, 3775, 3778, 3782, 3783, 3784, 3785, 3786, 3787, + 3788, 3789, 3790, 3791, 3792, 3796, 3797, 3798, 3801, 3802, + 3805, 3806, 3810, 3811, 3815, 3816, 3820, 3823, 3824, 3828, + 3829, 3833, 3834, 3838, 3839, 3843, 3844, 3848, 3849, 3850, + 3851, 3852, 3856, 3857, 3861, 3862, 3866, 3867, 3868, 3869, + 3870, 3876, 3875, 3879, 3878, 3883, 3887, 3888, 3892, 3893, + 3894, 3895, 3896, 3897, 3898, 3899, 3900, 3901, 3902, 3906, + 3910, 3910, 3913, 3914, 3919, 3918, 3939, 3938, 3963, 3964, + 3967, 3968, 3971, 3974, 3975, 3978, 3979, 3982, 3983, 3986, + 3987, 3991, 3996, 3995, 4034, 4033, 4085, 4086, 4087, 4091, + 4092, 4097, 4100, 4101, 4104, 4105, 4110, 4109, 4123, 4124, + 4123, 4135, 4136, 4138, 4139, 4142, 4146, 4149, 4155, 4159, + 4168, 4178, 4180, 4189, 4197, 4205, 4213, 4217, 4221, 4222, + 4225, 4226, 4229, 4233, 4237, 4238, 4241, 4245, 4246, 4246, + 4253, 4252, 4266, 4265, 4278, 4279, 4278, 4293, 4293, 4317, + 4318, 4319, 4323, 4324, 4329, 4337, 4348, 4349, 4359, 4362, + 4363, 4367, 4368, 4372, 4374, 4376, 4381, 4386, 4387, 4385, + 4411, 4436, 4441, 4442, 4446, 4463, 4462, 4467, 4468, 4472, + 4477, 4476, 4491, 4508, 4513, 4557, 4558, 4562, 4563, 4563, + 4568, 4569, 4574, 4586, 4600, 4602, 4607, 4608, 4613, 4612, + 4648, 4649, 4756, 4757, 4758, 4759, 4760, 4777, 4870, 4871 +}; +#endif + +#if YYDEBUG || YYERROR_VERBOSE || 0 +/* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM. + First, the terminals, then, starting at YYNTOKENS, nonterminals. */ +static const char *const yytname[] = +{ + "$end", "error", "$undefined", "','", "':'", "'='", "TOK_NEQV", + "TOK_EQV", "TOK_XOR", "TOK_OR", "TOK_AND", "TOK_NOT", "TOK_NE", "TOK_EQ", + "TOK_GE", "TOK_LE", "TOK_GT", "TOK_LT", "TOK_DSLASH", "'+'", "'-'", + "'*'", "TOK_SLASH", "TOK_DASTER", "TOK_SEMICOLON", "TOK_PARAMETER", + "TOK_RESULT", "TOK_ONLY", "TOK_INCLUDE", "TOK_SUBROUTINE", "TOK_PROGRAM", + "TOK_FUNCTION", "TOK_LABEL_FORMAT", "TOK_LABEL_CONTINUE", + "TOK_LABEL_END_DO", "TOK_MAX", "TOK_TANH", "TOK_COMMENT", "TOK_WHERE", + "TOK_ELSEWHEREPAR", "TOK_ELSEWHERE", "TOK_ENDWHERE", "TOK_MAXVAL", + "TOK_TRIM", "TOK_NULL_PTR", "TOK_SUM", "TOK_SQRT", "TOK_CASE", + "TOK_SELECTCASE", "TOK_FILE", "TOK_REC", "TOK_NAME_EQ", "TOK_IOLENGTH", + "TOK_ACCESS", "TOK_ACTION", "TOK_FORM", "TOK_RECL", "TOK_STATUS", + "TOK_UNIT", "TOK_OPENED", "TOK_FMT", "TOK_NML", "TOK_END", "TOK_EOR", + "TOK_EOF", "TOK_ERR", "TOK_POSITION", "TOK_IOSTAT", "TOK_IOMSG", + "TOK_EXIST", "TOK_MIN", "TOK_FLOAT", "TOK_EXP", "TOK_LEN", "TOK_COS", + "TOK_COSH", "TOK_ACOS", "TOK_NINT", "TOK_CYCLE", "TOK_SIN", "TOK_SINH", + "TOK_ASIN", "TOK_EQUIVALENCE", "TOK_BACKSPACE", "TOK_LOG", "TOK_TAN", + "TOK_ATAN", "TOK_RECURSIVE", "TOK_ABS", "TOK_MOD", "TOK_SIGN", + "TOK_MINLOC", "TOK_MAXLOC", "TOK_EXIT", "TOK_KIND", "TOK_MOLD", + "TOK_SOURCE", "TOK_ERRMSG", "TOK_MINVAL", "TOK_PUBLIC", "TOK_PRIVATE", + "TOK_ALLOCATABLE", "TOK_RETURN", "TOK_THEN", "TOK_ELSEIF", "TOK_ELSE", + "TOK_ENDIF", "TOK_PRINT", "TOK_PLAINGOTO", "TOK_LOGICALIF", + "TOK_LOGICALIF_PAR", "TOK_PLAINDO", "TOK_CONTAINS", "TOK_ENDDO", + "TOK_MODULE", "TOK_ENDMODULE", "TOK_WHILE", "TOK_CONCURRENT", + "TOK_ALLOCATE", "TOK_OPEN", "TOK_CLOSE", "TOK_INQUIRE", "TOK_WRITE_PAR", + "TOK_WRITE", "TOK_FLUSH", "TOK_READ_PAR", "TOK_READ", "TOK_REWIND", + "TOK_DEALLOCATE", "TOK_NULLIFY", "TOK_DIMENSION", "TOK_ENDSELECT", + "TOK_EXTERNAL", "TOK_INTENT", "TOK_INTRINSIC", "TOK_NAMELIST", + "TOK_DEFAULT", "TOK_OPTIONAL", "TOK_POINTER", "TOK_CONTINUE", "TOK_SAVE", + "TOK_TARGET", "TOK_IMPLICIT", "TOK_NONE", "TOK_CALL", "TOK_STAT", + "TOK_POINT_TO", "TOK_COMMON", "TOK_GLOBAL", "TOK_LEFTAB", "TOK_RIGHTAB", + "TOK_PAUSE", "TOK_PROCEDURE", "TOK_STOP", "TOK_FOURDOTS", "TOK_HEXA", + "TOK_ASSIGNTYPE", "TOK_OUT", "TOK_INOUT", "TOK_IN", "TOK_USE", + "TOK_EQUALEQUAL", "TOK_SLASHEQUAL", "TOK_INFEQUAL", "TOK_SUPEQUAL", + "TOK_TRUE", "TOK_FALSE", "TOK_LABEL", "TOK_LABEL_DJVIEW", + "TOK_PLAINDO_LABEL_DJVIEW", "TOK_PLAINDO_LABEL", "TOK_TYPE", + "TOK_TYPEPAR", "TOK_ENDTYPE", "TOK_COMMACOMPLEX", "TOK_REAL", + "TOK_INTEGER", "TOK_LOGICAL", "TOK_DOUBLEPRECISION", "TOK_ENDSUBROUTINE", + "TOK_ENDFUNCTION", "TOK_ENDPROGRAM", "TOK_ENDUNIT", "TOK_CHARACTER", + "TOK_CHAR_CONSTANT", "TOK_CHAR_CUT", "TOK_DATA", "TOK_CHAR_MESSAGE", + "TOK_CSTREAL", "TOK_COMPLEX", "TOK_DOUBLECOMPLEX", "TOK_NAME", + "TOK_CSTINT", "'('", "')'", "'<'", "'>'", "'\\n'", "'/'", "'%'", "'_'", + "'['", "']'", "$accept", "input", "line", "line-break", + "suite_line_list", "suite_line", "fin_line", "program-unit", + "external-subprogram", "filename", "opt_comma", "uexpr", "signe", + "operation", "after_slash", "after_equal", "lhs", "beforefunctionuse", + "array_ele_substring_func_ref", "$@4", "$@5", "begin_array", "$@6", + "structure_component", "funarglist", "funargs", "funarg", "triplet", + "ident", "simple_const", "string_constant", "opt_substring", "opt_expr", + "specification-part", "opt-use-stmt-list", + "opt-declaration-construct-list", "declaration-construct-list", + "declaration-construct", "opt-execution-part", "execution-part", + "opt-execution-part-construct-list", "execution-part-construct-list", + "execution-part-construct", "opt-internal-subprogram-part", + "internal-subprogram-part", "opt-internal-subprogram", + "internal-subprogram-list", "internal-subprogram", + "other-specification-stmt", "executable-construct", "action-stmt", + "keyword", "scalar-constant", "constant", "literal-constant", + "named-constant", "opt-label", "label", "opt-label-djview", + "label-djview", "type-param-value", "declaration-type-spec", "$@7", + "intrinsic-type-spec", "$@8", "$@9", "$@10", "$@11", "$@12", "$@13", + "opt-kind-selector", "kind-selector", "signed-int-literal-constant", + "int-literal-constant", "kind-param", "signed-real-literal-constant", + "real-literal-constant", "complex-literal-constant", "real-part", + "imag-part", "opt-char_length-star", "opt-char-selector", + "char-selector", "length-selector", "char-length", + "char-literal-constant", "logical-literal-constant", "derived-type-def", + "$@14", "derived-type-stmt", "opt-type-attr-spec-list-comma-fourdots", + "opt-type-attr-spec-list-comma", "type-attr-spec-list", "type-attr-spec", + "type-param-name-list", "type-param-name", "end-type-stmt", + "opt-component-part", "component-part", "component-def-stmt", + "data-component-def-stmt", "opt-component-attr-spec-list-comma-2points", + "component-attr-spec-list", "component-attr-spec", "component-decl-list", + "component-decl", "opt-component-array-spec", "component-array-spec", + "opt-component-initialization", "component-initialization", + "initial-data-target", "derived-type-spec", "type-param-spec-list", + "type-param-spec", "structure-constructor", "component-spec-list", + "component-spec", "component-data-source", "array-constructor", + "ac-spec", "lbracket", "rbracket", "ac-value-list", "ac-value", + "ac-implied-do", "ac-implied-do-control", "ac-do-variable", + "type-declaration-stmt", "$@15", "$@16", "opt-attr-spec-construct", + "opt-attr-spec-comma-list", "attr-spec-comma-list", "attr-spec", "$@17", + "$@18", "entity-decl-list", "entity-decl", "object-name", + "object-name-noident", "opt-initialization", "initialization", + "null-init", "access-spec", "opt-array-spec-par", "$@19", "array-spec", + "explicit-shape-spec-list", "explicit-shape-spec", "lower-bound", + "upper-bound", "assumed-shape-spec-list", "assumed-shape-spec", + "deferred-shape-spec-list", "deferred-shape-spec", "assumed-size-spec", + "opt-explicit-shape-spec-list-comma", "opt-lower-bound-2points", + "implied-shape-spec-list", "implied-shape-spec", "intent-spec", + "access-stmt", "$@20", "opt-access-id-list", "access-id-list", + "access-id", "data-stmt", "$@21", "opt-data-stmt-set-nlist", + "data-stmt-set-nlist", "data-stmt-set", "data-stmt-object-list", + "data-stmt-value-list", "data-stmt-object", "data-implied-do", + "data-i-do-object-list", "data-i-do-object", "data-i-do-variable", + "data-stmt-value", "opt-data-stmt-star", "data-stmt-constant", + "scalar-constant-subobject", "constant-subobject", "dimension-stmt", + "$@22", "$@23", "array-name-spec-list", "$@24", "$@25", "parameter-stmt", + "$@26", "$@27", "named-constant-def-list", "named-constant-def", + "save-stmt", "$@28", "$@29", "opt-TOK_FOURDOTS", "opt-saved-entity-list", + "saved-entity-list", "saved-entity", "proc-pointer-name", + "get_my_position", "implicit-stmt", "$@30", "implicit-spec-list", + "implicit-spec", "letter-spec-list", "letter-spec", "namelist-stmt", + "opt-namelist-other", "namelist-group-object-list", + "namelist-group-object", "equivalence-stmt", "equivalence-set-list", + "equivalence-set", "$@31", "equivalence-object-list", + "equivalence-object", "common-stmt", "$@32", "$@33", + "opt-common-block-name", "common-block-name", "opt-comma", + "opt-common-block-list", "$@34", "common-block-object-list", + "common-block-object", "$@35", "designator", "scalar-variable", + "variable", "variable-name", "scalar-logical-variable", + "logical-variable", "char-variable", "scalar-default-char-variable", + "default-char-variable", "scalar-int-variable", "int-variable", + "substring", "substring-range", "data-ref", "opt-part-ref", "part-ref", + "$@36", "scalar-structure-component", "structure-component", + "array-element", "array-section", "section-subscript-list", + "section-subscript", "section_subscript_ambiguous", "vector-subscript", + "allocate-stmt", "$@37", "$@38", "opt-alloc-opt-list-comma", + "alloc-opt-list", "alloc-opt", "stat-variable", "errmsg-variable", + "allocation-list", "allocation", "allocate-object", + "opt-allocate-shape-spec-list-par", "allocate-shape-spec-list", + "allocate-shape-spec", "opt-lower-bound-expr", "lower-bound-expr", + "upper-bound-expr", "deallocate-stmt", "$@39", "$@40", + "allocate-object-list", "opt-dealloc-opt-list-comma", "dealloc-opt-list", + "dealloc-opt", "primary", "level-1-expr", "mult-operand", "add-operand", + "level-2-expr", "power-op", "mult-op", "add-op", "level-3-expr", + "concat-op", "level-4-expr", "rel-op", "and-operand", "or-operand", + "equiv-operand", "level-5-expr", "not-op", "and-op", "or-op", "equiv-op", + "expr", "scalar-default-char-expr", "default-char-expr", "int-expr", + "opt-scalar-int-expr", "scalar-int-expr", "specification-expr", + "constant-expr", "scalar-default-char-constant-expr", + "default-char-constant-expr", "scalar-int-constant-expr", + "int-constant-expr", "assignment-stmt", "pointer-assignment-stmt", + "opt-bounds-spec-list-par", "bounds-spec-list", "bounds-remapping-list", + "bounds-spec", "bounds-remapping", "data-target", + "procedure-component-name", "proc-component-ref", "proc-target", + "where-stmt", "where-construct", "opt-where-body-construct", + "opt-masked-elsewhere-construct", "opt-elsewhere-construct", + "where-construct-stmt", "where-body-construct", "where-assignment-stmt", + "mask-expr", "masked-elsewhere-stmt", "elsewhere-stmt", "end-where-stmt", + "forall-header", "block", "opt-execution-part-construct", "do-construct", + "block-do-construct", "label-do-stmt", "label-do-stmt-djview", + "nonlabel-do-stmt", "loop-control", "do-variable", "do-block", "end-do", + "end-do-stmt", "nonblock-do-construct", "action-term-do-construct", + "do-term-action-stmt", "do-term-action-stmt-special", + "outer-shared-do-construct", "label-do-stmt-djview-do-block-list", + "inner-shared-do-construct", "do-term-shared-stmt", + "opt-do-construct-name", "cycle-stmt", "if-construct", + "opt-else-if-stmt-block", "else-if-stmt-block", "opt-else-stmt-block", + "else-stmt-block", "if-then-stmt", "else-if-stmt", "else-stmt", + "end-if-stmt", "if-stmt", "case-construct", "opt_case-stmt-block", + "case-stmt-block", "select-case-stmt", "$@41", "$@42", "case-stmt", + "end-select-stmt", "$@43", "$@44", "case-selector", "$@45", + "case-value-range-list", "case-value-range", "case-value", "exit-stmt", + "goto-stmt", "arithmetic-if-stmt", "continue-stmt", "stop-stmt", + "stop-code", "io-unit", "file-unit-number", "internal-file-variable", + "open-stmt", "$@46", "$@47", "connect-spec-list", "connect-spec", + "file-name-expr", "iomsg-variable", "close-stmt", "$@48", + "close-spec-list", "close-spec", "read-stmt", "$@49", "$@50", + "write-stmt", "$@51", "$@52", "print-stmt", "io-control-spec-list", + "namelist-group-name", "io-control-spec", "format", "input-item-list", + "input-item", "output-item-list", "output-item", "io-implied-do", + "io-implied-do-object-list", "io-implied-do-object", + "io-implied-do-control", "rewind-stmt", "position-spec-list", + "position-spec", "flush-stmt", "flush-spec-list", "flush-spec", + "inquire-stmt", "$@53", "$@54", "set_in_inquire", "inquire-spec-list", + "inquire-spec", "format-stmt", "module", "$@55", + "opt-module-subprogram-part", "module-stmt", "$@56", "end-module-stmt", + "$@57", "opt-tok-module", "opt-ident", "module-subprogram-part", + "opt-module-subprogram-list", "module-subprogram-list", + "module-subprogram", "use-stmt-list", "save_olduse", "use-stmt", "$@58", + "$@59", "opt-module-nature-2points", "opt-only-list", "main-program", + "opt-specification-part", "program-stmt", "$@60", "end-program-stmt", + "$@61", "$@62", "opt-tok-program", "opt-tok-name", "module-nature", + "opt-rename-list", "rename-list", "rename", "only-list", "only", + "only-use-name", "generic-spec", "external-stmt", "external-name-list", + "external-name", "intrinsic-stmt", "intrinsic-procedure-name-list", + "intrinsic-procedure-name", "function-reference", "$@63", "call-stmt", + "$@64", "$@65", "$@66", "$@67", "before-call-stmt", "$@68", + "procedure-designator", "actual-arg-spec-list", "actual-arg-spec", + "actual-arg", "opt-prefix", "prefix", "prefix-spec", + "function-subprogram", "function-stmt", "$@69", "$@70", "function-name", + "dummy-arg-name", "opt-suffix", "suffix", "end-function-stmt", "$@71", + "opt-tok-function", "subroutine-subprogram", "subroutine-stmt", "$@72", + "subroutine-name", "end-subroutine-stmt", "close_subroutine", + "opt-tok-subroutine", "opt-dummy-arg-list-par", "$@73", + "opt-dummy-arg-list", "dummy-arg-list", "dummy-arg", "return-stmt", + "contains-stmt", "$@74", "opt_name", "after_rewind", + "declare_after_percent", "pointer_name_list", YY_NULL +}; +#endif + +# ifdef YYPRINT +/* YYTOKNUM[YYLEX-NUM] -- Internal token number corresponding to + token YYLEX-NUM. */ +static const yytype_uint16 yytoknum[] = +{ + 0, 256, 257, 44, 58, 61, 258, 259, 260, 261, + 262, 263, 264, 265, 266, 267, 268, 269, 270, 43, + 45, 42, 271, 272, 273, 274, 275, 276, 277, 278, + 279, 280, 281, 282, 283, 284, 285, 286, 287, 288, + 289, 290, 291, 292, 293, 294, 295, 296, 297, 298, + 299, 300, 301, 302, 303, 304, 305, 306, 307, 308, + 309, 310, 311, 312, 313, 314, 315, 316, 317, 318, + 319, 320, 321, 322, 323, 324, 325, 326, 327, 328, + 329, 330, 331, 332, 333, 334, 335, 336, 337, 338, + 339, 340, 341, 342, 343, 344, 345, 346, 347, 348, + 349, 350, 351, 352, 353, 354, 355, 356, 357, 358, + 359, 360, 361, 362, 363, 364, 365, 366, 367, 368, + 369, 370, 371, 372, 373, 374, 375, 376, 377, 378, + 379, 380, 381, 382, 383, 384, 385, 386, 387, 388, + 389, 390, 391, 392, 393, 394, 395, 396, 397, 398, + 399, 400, 401, 402, 403, 404, 405, 406, 407, 408, + 409, 410, 411, 412, 413, 414, 415, 416, 417, 418, + 419, 420, 421, 422, 423, 424, 425, 426, 427, 428, + 429, 430, 431, 432, 433, 434, 435, 436, 437, 438, + 439, 440, 441, 40, 41, 60, 62, 10, 47, 37, + 95, 91, 93 +}; +# endif + +/* YYR1[YYN] -- Symbol number of symbol that rule YYN derives. */ +static const yytype_uint16 yyr1[] = +{ + 0, 203, 204, 204, 205, 205, 205, 206, 206, 206, + 206, 206, 207, 207, 207, 208, 208, 208, 209, 210, + 210, 210, 211, 211, 212, 213, 213, 214, 214, 214, + 214, 214, 215, 215, 216, 216, 216, 216, 216, 216, + 216, 216, 216, 216, 216, 216, 216, 216, 216, 216, + 216, 216, 216, 216, 216, 217, 217, 217, 217, 218, + 218, 219, 219, 219, 220, 221, 221, 222, 221, 223, + 221, 224, 225, 224, 226, 227, 227, 228, 228, 229, + 229, 230, 230, 230, 230, 230, 230, 230, 231, 232, + 232, 232, 232, 232, 232, 232, 232, 233, 233, 233, + 233, 234, 234, 235, 235, 236, 237, 237, 238, 238, + 239, 239, 240, 240, 240, 240, 240, 240, 240, 240, + 240, 240, 240, 240, 240, 241, 241, 242, 243, 243, + 244, 244, 245, 245, 246, 246, 247, 248, 248, 249, + 249, 250, 250, 251, 251, 251, 251, 251, 251, 251, + 251, 251, 252, 252, 252, 252, 252, 253, 253, 253, + 253, 253, 253, 253, 253, 253, 253, 253, 253, 253, + 253, 253, 253, 253, 253, 253, 253, 253, 253, 253, + 253, 253, 254, 255, 256, 256, 257, 257, 257, 257, + 257, 258, 259, 259, 260, 260, 261, 261, 262, 263, + 263, 263, 265, 264, 264, 264, 267, 266, 268, 266, + 269, 266, 270, 266, 271, 266, 272, 266, 273, 273, + 274, 274, 274, 275, 275, 276, 276, 277, 277, 278, + 278, 279, 279, 280, 281, 281, 281, 282, 282, 282, + 283, 283, 284, 284, 285, 285, 285, 285, 285, 286, + 286, 286, 286, 287, 287, 288, 288, 288, 289, 289, + 291, 290, 292, 292, 293, 293, 294, 294, 295, 295, + 296, 297, 297, 298, 299, 299, 300, 300, 301, 301, + 302, 303, 304, 304, 304, 305, 305, 306, 306, 306, + 306, 307, 307, 308, 309, 309, 310, 310, 311, 311, + 312, 312, 312, 313, 314, 314, 315, 315, 316, 316, + 317, 317, 318, 318, 319, 319, 320, 320, 320, 321, + 321, 322, 323, 324, 325, 325, 326, 326, 327, 328, + 328, 329, 331, 332, 330, 333, 333, 334, 334, 335, + 335, 336, 336, 337, 336, 336, 338, 336, 336, 336, + 336, 336, 336, 336, 339, 339, 340, 341, 342, 343, + 343, 344, 344, 344, 345, 346, 346, 347, 348, 347, + 349, 349, 349, 349, 349, 350, 350, 351, 351, 352, + 353, 354, 354, 355, 355, 356, 356, 357, 358, 359, + 359, 360, 360, 361, 361, 362, 363, 363, 363, 365, + 364, 366, 366, 367, 367, 368, 368, 370, 369, 371, + 371, 372, 372, 373, 374, 374, 375, 375, 376, 376, + 377, 377, 378, 378, 379, 379, 379, 380, 381, 381, + 381, 381, 381, 381, 381, 381, 382, 382, 383, 383, + 383, 383, 383, 383, 383, 384, 385, 387, 388, 386, + 390, 389, 391, 389, 393, 394, 392, 395, 395, 396, + 398, 399, 397, 400, 400, 401, 401, 402, 402, 403, + 403, 403, 404, 405, 406, 407, 406, 408, 408, 409, + 410, 410, 411, 411, 412, 413, 413, 414, 414, 415, + 416, 417, 417, 419, 418, 420, 420, 421, 421, 421, + 423, 424, 422, 425, 425, 426, 426, 427, 427, 428, + 429, 428, 430, 430, 431, 432, 431, 433, 433, 433, + 433, 434, 435, 436, 437, 438, 439, 440, 441, 442, + 443, 444, 444, 444, 445, 446, 447, 447, 448, 449, + 448, 450, 451, 452, 453, 453, 454, 454, 454, 455, + 455, 455, 455, 455, 455, 455, 455, 455, 455, 456, + 456, 456, 456, 456, 456, 457, 459, 460, 458, 461, + 461, 462, 462, 463, 463, 464, 465, 466, 466, 467, + 468, 468, 469, 469, 470, 470, 471, 472, 472, 473, + 474, 476, 477, 475, 478, 478, 479, 479, 480, 480, + 481, 481, 482, 482, 482, 482, 482, 483, 484, 484, + 485, 485, 486, 486, 486, 486, 486, 487, 488, 488, + 489, 489, 490, 490, 491, 492, 492, 493, 493, 493, + 493, 493, 493, 493, 493, 493, 493, 493, 493, 494, + 494, 495, 495, 496, 496, 497, 497, 498, 499, 500, + 501, 501, 502, 503, 504, 505, 506, 506, 507, 508, + 509, 510, 511, 512, 513, 514, 514, 515, 515, 515, + 516, 516, 517, 517, 518, 518, 519, 520, 521, 522, + 523, 524, 524, 524, 525, 526, 527, 527, 528, 528, + 529, 529, 530, 531, 531, 531, 532, 533, 534, 534, + 535, 535, 536, 536, 537, 538, 539, 539, 540, 540, + 540, 541, 541, 542, 542, 542, 542, 543, 543, 543, + 543, 544, 544, 544, 544, 545, 545, 545, 545, 546, + 547, 548, 548, 549, 549, 550, 550, 551, 552, 553, + 553, 553, 553, 553, 553, 553, 553, 553, 553, 553, + 553, 553, 553, 553, 553, 553, 554, 554, 555, 555, + 556, 557, 558, 558, 559, 560, 561, 561, 561, 562, + 563, 563, 563, 564, 565, 565, 566, 566, 567, 567, + 568, 568, 569, 570, 571, 571, 571, 572, 574, 573, + 575, 573, 576, 576, 578, 577, 579, 577, 581, 580, + 580, 582, 582, 583, 583, 583, 583, 584, 585, 585, + 586, 587, 588, 589, 589, 590, 590, 591, 591, 591, + 592, 593, 595, 596, 594, 597, 597, 598, 598, 598, + 598, 598, 598, 598, 598, 598, 598, 598, 599, 600, + 602, 601, 603, 603, 604, 604, 604, 604, 604, 606, + 605, 607, 605, 605, 605, 609, 608, 610, 608, 611, + 611, 612, 612, 613, 614, 614, 614, 614, 614, 614, + 614, 614, 614, 614, 614, 615, 615, 615, 616, 616, + 617, 617, 618, 618, 619, 619, 620, 621, 621, 622, + 622, 623, 623, 624, 624, 625, 625, 626, 626, 626, + 626, 626, 627, 627, 628, 628, 629, 629, 629, 629, + 629, 631, 630, 632, 630, 633, 634, 634, 635, 635, + 635, 635, 635, 635, 635, 635, 635, 635, 635, 636, + 638, 637, 639, 639, 641, 640, 643, 642, 644, 644, + 645, 645, 646, 647, 647, 648, 648, 649, 649, 650, + 650, 651, 653, 652, 654, 652, 655, 655, 655, 656, + 656, 657, 658, 658, 241, 241, 660, 659, 662, 663, + 661, 664, 664, 665, 665, 666, 667, 667, 668, 668, + 669, 670, 670, 671, 671, 671, 672, 673, 674, 674, + 675, 675, 676, 677, 678, 678, 679, 680, 681, 680, + 683, 682, 684, 682, 685, 686, 682, 688, 687, 689, + 689, 689, 690, 690, 691, 691, 692, 692, 692, 693, + 693, 694, 694, 695, 695, 695, 696, 698, 699, 697, + 700, 701, 702, 702, 703, 705, 704, 706, 706, 707, + 709, 708, 710, 711, 712, 713, 713, 714, 715, 714, + 716, 716, 717, 717, 718, 718, 719, 719, 721, 720, + 722, 722, 723, 723, 723, 723, 723, 724, 725, 725 +}; + +/* YYR2[YYN] -- Number of symbols composing right hand side of rule YYN. */ +static const yytype_uint8 yyr2[] = +{ + 0, 2, 0, 2, 1, 1, 1, 2, 1, 1, + 3, 2, 1, 3, 3, 1, 3, 1, 0, 1, + 1, 1, 1, 1, 1, 0, 1, 1, 1, 2, + 2, 2, 1, 1, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 3, 3, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 0, 1, 2, 2, 2, + 1, 1, 1, 1, 0, 1, 2, 0, 5, 0, + 6, 1, 0, 5, 4, 1, 2, 1, 3, 1, + 1, 3, 5, 4, 3, 2, 2, 1, 1, 1, + 1, 1, 1, 1, 1, 2, 2, 1, 2, 1, + 1, 0, 1, 0, 1, 2, 0, 1, 0, 1, + 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 0, 1, 2, 0, 1, + 1, 2, 1, 1, 0, 1, 3, 0, 1, 1, + 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 2, 4, 2, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 0, 1, 1, 1, 0, 1, 1, 1, + 1, 1, 0, 2, 3, 3, 0, 3, 0, 3, + 0, 3, 0, 3, 0, 3, 0, 3, 0, 1, + 3, 5, 2, 1, 2, 1, 3, 1, 1, 1, + 2, 1, 3, 5, 1, 1, 1, 1, 1, 1, + 0, 2, 0, 1, 1, 9, 5, 5, 9, 3, + 5, 2, 3, 3, 1, 1, 1, 1, 1, 1, + 0, 4, 4, 7, 0, 2, 0, 2, 1, 3, + 1, 1, 3, 1, 2, 3, 0, 1, 1, 2, + 1, 4, 0, 1, 3, 1, 3, 1, 1, 4, + 1, 1, 3, 4, 0, 3, 1, 1, 0, 1, + 2, 2, 2, 1, 1, 4, 1, 3, 1, 3, + 3, 4, 1, 3, 1, 3, 1, 1, 1, 3, + 3, 1, 1, 1, 1, 3, 1, 1, 5, 5, + 7, 1, 0, 0, 6, 0, 2, 0, 1, 2, + 3, 1, 1, 0, 5, 1, 0, 5, 1, 1, + 1, 1, 1, 1, 1, 3, 4, 1, 1, 0, + 1, 2, 2, 2, 1, 1, 1, 0, 0, 4, + 1, 1, 1, 1, 1, 1, 3, 3, 1, 1, + 1, 1, 3, 1, 2, 1, 3, 1, 3, 0, + 2, 0, 2, 1, 3, 2, 1, 1, 1, 0, + 4, 0, 2, 1, 3, 1, 1, 0, 5, 0, + 1, 2, 3, 4, 1, 3, 1, 3, 1, 1, + 9, 11, 1, 3, 1, 1, 1, 1, 2, 2, + 2, 1, 1, 1, 1, 1, 0, 2, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 0, 0, 6, + 0, 5, 0, 7, 0, 0, 7, 1, 3, 3, + 0, 0, 6, 0, 1, 0, 1, 1, 3, 1, + 1, 1, 1, 0, 4, 0, 5, 1, 3, 4, + 1, 3, 1, 3, 7, 0, 6, 1, 3, 1, + 3, 1, 3, 0, 6, 1, 3, 1, 1, 1, + 0, 0, 7, 0, 1, 1, 3, 0, 1, 0, + 0, 5, 1, 3, 1, 0, 5, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 4, 4, 3, 2, 0, 3, 1, 0, + 5, 1, 1, 1, 1, 4, 0, 1, 3, 2, + 1, 2, 3, 4, 2, 1, 3, 4, 2, 1, + 2, 3, 4, 2, 0, 1, 0, 0, 8, 0, + 2, 1, 3, 2, 3, 1, 1, 1, 3, 2, + 1, 1, 0, 3, 1, 3, 2, 0, 2, 1, + 1, 0, 0, 8, 1, 3, 0, 2, 1, 3, + 2, 3, 1, 1, 1, 1, 3, 1, 1, 3, + 1, 3, 1, 2, 3, 1, 2, 1, 1, 1, + 1, 1, 1, 3, 1, 1, 3, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 2, 1, 3, 1, 3, 1, 3, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, + 1, 1, 1, 1, 1, 4, 5, 5, 7, 4, + 0, 3, 1, 3, 1, 3, 2, 3, 1, 1, + 3, 1, 1, 1, 5, 5, 0, 2, 0, 3, + 0, 3, 5, 1, 1, 1, 1, 1, 4, 5, + 2, 3, 2, 3, 0, 1, 0, 2, 1, 1, + 1, 3, 3, 4, 2, 5, 3, 4, 2, 5, + 3, 4, 2, 5, 3, 6, 8, 5, 3, 1, + 1, 1, 2, 3, 4, 1, 1, 3, 2, 1, + 1, 1, 1, 1, 1, 1, 2, 4, 1, 1, + 1, 1, 1, 1, 1, 1, 4, 3, 2, 3, + 3, 2, 0, 1, 3, 5, 0, 1, 2, 2, + 0, 1, 2, 2, 8, 6, 6, 7, 2, 3, + 2, 3, 5, 3, 0, 1, 2, 2, 0, 8, + 0, 6, 3, 4, 0, 3, 0, 4, 0, 4, + 1, 1, 3, 1, 2, 2, 3, 1, 2, 3, + 3, 10, 3, 2, 3, 1, 1, 1, 1, 1, + 1, 1, 0, 0, 7, 1, 3, 1, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 3, 1, 1, + 0, 7, 1, 3, 1, 2, 2, 2, 3, 0, + 6, 0, 7, 4, 6, 0, 6, 0, 7, 4, + 6, 1, 3, 1, 1, 2, 1, 1, 2, 2, + 2, 2, 2, 2, 3, 1, 1, 1, 1, 3, + 1, 1, 1, 3, 1, 1, 5, 1, 3, 1, + 1, 5, 7, 3, 5, 1, 3, 1, 2, 2, + 2, 2, 3, 5, 1, 3, 1, 2, 2, 2, + 2, 0, 7, 0, 9, 0, 1, 3, 1, 2, + 2, 2, 2, 2, 2, 2, 3, 2, 2, 2, + 0, 5, 0, 1, 0, 4, 0, 6, 0, 1, + 0, 1, 2, 0, 1, 1, 2, 1, 1, 1, + 2, 0, 0, 8, 0, 11, 0, 1, 3, 0, + 1, 5, 0, 1, 0, 1, 0, 4, 0, 0, + 6, 0, 1, 0, 1, 1, 0, 2, 1, 3, + 3, 1, 3, 1, 1, 1, 1, 1, 3, 4, + 1, 3, 1, 4, 1, 3, 1, 3, 0, 5, + 0, 3, 0, 5, 0, 0, 7, 0, 4, 1, + 1, 1, 1, 3, 1, 3, 1, 1, 1, 0, + 1, 1, 2, 1, 1, 1, 5, 0, 0, 10, + 1, 1, 0, 1, 4, 0, 7, 0, 1, 5, + 0, 6, 1, 6, 0, 0, 1, 0, 0, 4, + 0, 1, 1, 3, 1, 1, 3, 4, 0, 4, + 1, 1, 3, 3, 1, 3, 1, 0, 1, 3 +}; + +/* YYDEFACT[STATE-NAME] -- Default reduction number in state STATE-NUM. + Performed when YYTABLE doesn't specify something else to do. Zero + means the default is an error. */ +static const yytype_uint16 yydefact[] = +{ + 2, 0, 1, 6, 8, 0, 0, 17, 9, 1025, + 1024, 0, 18, 3, 4, 5, 12, 15, 20, 1023, + 0, 21, 106, 19, 106, 0, 202, 1021, 22, 106, + 23, 106, 24, 18, 966, 934, 208, 206, 216, 210, + 214, 212, 88, 304, 0, 0, 7, 11, 18, 202, + 203, 963, 108, 0, 107, 949, 192, 192, 0, 0, + 1024, 1022, 192, 192, 16, 0, 0, 218, 218, 218, + 218, 242, 218, 0, 204, 205, 10, 13, 14, 454, + 0, 0, 365, 366, 25, 0, 463, 0, 500, 194, + 25, 264, 255, 257, 0, 256, 88, 195, 538, 105, + 109, 110, 116, 0, 193, 0, 112, 260, 117, 202, + 401, 143, 145, 146, 0, 113, 151, 0, 0, 115, + 150, 147, 144, 522, 0, 520, 531, 536, 519, 517, + 518, 118, 119, 120, 708, 706, 706, 709, 735, 736, + 124, 706, 121, 123, 114, 148, 149, 122, 951, 950, + 0, 193, 930, 933, 202, 0, 0, 103, 0, 0, + 0, 0, 0, 915, 0, 0, 0, 0, 0, 88, + 134, 126, 192, 152, 0, 157, 163, 158, 173, 179, + 156, 686, 153, 162, 155, 170, 154, 784, 165, 164, + 181, 161, 178, 172, 160, 175, 180, 174, 177, 166, + 171, 159, 1000, 176, 1042, 1047, 1030, 0, 134, 134, + 967, 935, 0, 0, 209, 219, 207, 217, 211, 0, + 0, 215, 243, 244, 213, 201, 647, 620, 621, 200, + 1010, 0, 258, 259, 1011, 231, 225, 0, 322, 538, + 0, 603, 308, 615, 186, 187, 189, 190, 188, 0, + 306, 604, 0, 602, 607, 608, 610, 612, 622, 0, + 625, 639, 641, 643, 645, 652, 0, 655, 658, 199, + 605, 0, 0, 929, 493, 0, 491, 26, 722, 0, + 0, 0, 992, 0, 990, 464, 0, 0, 503, 714, + 0, 0, 0, 0, 0, 507, 0, 414, 419, 522, + 418, 0, 539, 111, 0, 0, 0, 0, 0, 0, + 656, 202, 335, 399, 0, 463, 463, 202, 0, 0, + 0, 0, 656, 535, 730, 192, 196, 196, 766, 956, + 1058, 473, 942, 202, 945, 947, 948, 0, 0, 88, + 538, 167, 104, 0, 0, 808, 0, 1061, 1060, 169, + 566, 822, 0, 0, 820, 0, 0, 0, 591, 0, + 813, 654, 662, 664, 815, 661, 816, 663, 0, 0, + 0, 968, 135, 127, 192, 130, 132, 133, 0, 0, + 0, 0, 0, 1007, 688, 0, 0, 785, 706, 1004, + 0, 1048, 1040, 1027, 473, 473, 222, 0, 0, 0, + 254, 251, 0, 0, 0, 0, 0, 321, 324, 327, + 326, 0, 0, 538, 615, 235, 187, 0, 0, 0, + 0, 0, 305, 0, 617, 0, 618, 619, 0, 616, + 223, 0, 186, 613, 628, 627, 632, 630, 631, 629, + 624, 633, 634, 636, 638, 635, 637, 0, 0, 648, + 0, 649, 0, 651, 650, 0, 640, 998, 0, 0, + 0, 490, 0, 704, 729, 0, 724, 0, 0, 988, + 996, 0, 994, 0, 505, 0, 0, 504, 716, 267, + 268, 270, 0, 265, 0, 426, 0, 422, 542, 425, + 541, 424, 508, 407, 507, 0, 0, 0, 25, 25, + 546, 1056, 0, 877, 225, 876, 654, 875, 0, 0, + 812, 0, 0, 0, 0, 657, 282, 0, 202, 278, + 280, 0, 0, 0, 338, 0, 405, 402, 403, 406, + 0, 465, 475, 0, 0, 477, 88, 602, 0, 521, + 681, 682, 683, 0, 0, 589, 0, 0, 672, 674, + 0, 0, 0, 0, 707, 198, 25, 0, 0, 192, + 706, 711, 731, 737, 0, 757, 192, 712, 0, 770, + 767, 706, 0, 957, 0, 0, 0, 931, 946, 697, + 0, 0, 764, 809, 810, 0, 0, 0, 0, 0, + 0, 0, 655, 906, 0, 904, 902, 0, 0, 0, + 0, 897, 0, 895, 893, 0, 1068, 0, 814, 0, + 202, 961, 0, 131, 0, 840, 818, 0, 0, 0, + 0, 0, 0, 0, 0, 88, 526, 821, 864, 817, + 819, 0, 867, 861, 866, 0, 0, 0, 0, 696, + 694, 695, 690, 687, 693, 800, 798, 0, 794, 786, + 783, 787, 1002, 0, 1001, 1050, 0, 1050, 0, 1026, + 0, 1039, 0, 220, 0, 0, 0, 0, 249, 0, + 326, 319, 0, 228, 227, 232, 226, 0, 187, 606, + 309, 307, 323, 320, 186, 609, 611, 614, 623, 626, + 642, 644, 646, 997, 0, 0, 0, 457, 523, 0, + 497, 499, 531, 498, 492, 0, 728, 0, 989, 991, + 0, 993, 0, 0, 514, 509, 512, 0, 262, 0, + 0, 0, 0, 411, 415, 538, 431, 223, 432, 229, + 436, 434, 0, 435, 433, 0, 416, 436, 445, 303, + 0, 364, 721, 0, 713, 0, 550, 0, 0, 538, + 0, 547, 555, 564, 565, 1057, 0, 859, 0, 0, + 0, 533, 656, 0, 283, 0, 0, 261, 279, 350, + 342, 0, 345, 0, 348, 349, 351, 352, 353, 339, + 341, 358, 333, 354, 367, 336, 0, 400, 0, 0, + 448, 357, 469, 461, 466, 467, 470, 471, 0, 0, + 202, 474, 0, 669, 676, 0, 671, 0, 0, 678, + 0, 665, 532, 537, 718, 0, 0, 0, 0, 0, + 0, 0, 739, 743, 740, 754, 738, 748, 745, 732, + 750, 742, 752, 755, 751, 753, 744, 749, 741, 758, + 706, 756, 0, 0, 0, 768, 0, 771, 706, 769, + 975, 0, 976, 1059, 938, 0, 790, 580, 542, 581, + 569, 577, 582, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 827, 0, 825, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 918, 0, 916, + 907, 910, 530, 908, 529, 528, 839, 527, 909, 0, + 0, 898, 901, 900, 899, 0, 0, 594, 596, 0, + 168, 0, 136, 202, 139, 141, 142, 971, 192, 0, + 0, 818, 865, 869, 863, 868, 870, 871, 872, 873, + 0, 855, 849, 0, 853, 1009, 1008, 0, 0, 686, + 0, 0, 792, 796, 0, 0, 538, 0, 1017, 1016, + 0, 1012, 1014, 1055, 1031, 1054, 0, 1051, 1052, 1041, + 0, 1037, 1045, 0, 253, 0, 0, 0, 0, 325, + 191, 239, 237, 238, 0, 0, 0, 0, 455, 0, + 656, 0, 0, 995, 523, 485, 487, 489, 506, 515, + 0, 501, 269, 273, 0, 271, 538, 423, 0, 427, + 408, 412, 539, 0, 429, 430, 0, 0, 413, 428, + 224, 230, 723, 715, 0, 551, 558, 554, 0, 0, + 540, 559, 0, 549, 0, 884, 0, 882, 885, 0, + 0, 666, 534, 288, 0, 290, 0, 285, 287, 294, + 0, 291, 0, 274, 343, 346, 0, 0, 368, 240, + 340, 404, 450, 0, 0, 0, 0, 476, 482, 0, + 480, 478, 679, 680, 677, 590, 0, 673, 0, 675, + 0, 667, 720, 25, 0, 733, 0, 1066, 1064, 0, + 746, 0, 0, 192, 760, 759, 0, 0, 778, 0, + 772, 765, 773, 958, 0, 952, 939, 940, 692, 684, + 0, 0, 0, 0, 579, 838, 653, 832, 829, 830, + 833, 836, 0, 828, 831, 835, 834, 0, 823, 920, + 0, 0, 921, 922, 928, 919, 525, 927, 524, 923, + 925, 924, 0, 911, 905, 903, 896, 894, 0, 0, + 1069, 0, 140, 972, 973, 782, 0, 193, 0, 0, + 0, 0, 844, 0, 842, 874, 862, 0, 857, 0, + 880, 0, 851, 878, 881, 0, 0, 0, 0, 686, + 685, 689, 0, 807, 0, 801, 803, 793, 0, 795, + 1003, 0, 0, 1005, 1049, 0, 1032, 1038, 940, 1046, + 940, 221, 0, 250, 0, 247, 246, 538, 0, 0, + 331, 233, 999, 660, 459, 458, 0, 0, 495, 0, + 727, 0, 0, 507, 389, 513, 0, 0, 0, 0, + 0, 0, 191, 438, 183, 184, 185, 440, 441, 443, + 444, 442, 437, 439, 310, 0, 0, 312, 314, 678, + 316, 317, 318, 417, 552, 0, 0, 556, 548, 0, + 560, 563, 884, 889, 890, 881, 0, 887, 0, 860, + 775, 0, 0, 0, 284, 0, 240, 0, 281, 275, + 389, 0, 355, 334, 389, 0, 359, 389, 0, 449, + 462, 468, 0, 0, 479, 676, 0, 0, 717, 0, + 734, 0, 0, 32, 33, 91, 71, 94, 258, 259, + 255, 257, 256, 231, 225, 0, 0, 27, 63, 65, + 62, 538, 28, 101, 655, 0, 0, 761, 0, 779, + 0, 780, 0, 0, 977, 978, 0, 941, 936, 791, + 0, 0, 570, 571, 578, 567, 0, 584, 0, 0, + 837, 826, 0, 926, 0, 917, 0, 0, 0, 595, + 597, 598, 592, 788, 974, 969, 0, 0, 0, 845, + 847, 846, 0, 0, 856, 0, 850, 0, 0, 854, + 0, 0, 700, 0, 702, 691, 805, 0, 799, 804, + 797, 538, 1015, 1013, 0, 1053, 0, 1028, 1033, 1044, + 1044, 0, 0, 328, 0, 456, 0, 494, 532, 725, + 488, 484, 0, 383, 0, 370, 375, 0, 378, 371, + 381, 372, 385, 373, 391, 0, 374, 393, 659, 380, + 502, 510, 272, 263, 0, 236, 234, 0, 0, 311, + 553, 557, 561, 0, 0, 883, 0, 387, 0, 296, + 0, 297, 286, 0, 298, 292, 0, 397, 398, 396, + 0, 0, 241, 0, 0, 356, 360, 0, 452, 483, + 481, 668, 719, 0, 31, 1063, 1065, 30, 1067, 66, + 531, 67, 72, 1062, 95, 98, 96, 102, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 55, 0, 0, 0, 29, 747, 192, + 0, 781, 959, 0, 0, 953, 0, 576, 573, 0, + 0, 0, 0, 583, 586, 588, 824, 913, 912, 600, + 0, 0, 0, 0, 0, 0, 0, 848, 843, 841, + 858, 879, 852, 0, 698, 701, 703, 802, 806, 1006, + 0, 0, 1035, 0, 0, 0, 0, 496, 0, 0, + 516, 390, 384, 0, 0, 0, 0, 379, 395, 391, + 0, 0, 315, 313, 562, 0, 888, 0, 774, 289, + 0, 0, 295, 0, 0, 293, 299, 344, 347, 369, + 361, 363, 362, 303, 451, 389, 0, 64, 64, 64, + 0, 54, 60, 49, 39, 50, 51, 52, 48, 38, + 46, 47, 40, 45, 34, 35, 36, 0, 0, 53, + 56, 37, 0, 42, 0, 41, 0, 776, 986, 954, + 985, 960, 981, 984, 983, 980, 979, 937, 575, 574, + 572, 568, 585, 0, 601, 599, 593, 789, 970, 192, + 0, 699, 0, 1029, 0, 1043, 0, 0, 0, 726, + 0, 376, 377, 380, 383, 0, 382, 386, 392, 388, + 394, 511, 0, 0, 886, 300, 302, 301, 0, 74, + 61, 75, 0, 0, 0, 59, 57, 58, 44, 43, + 777, 0, 0, 914, 0, 1034, 1036, 245, 248, 329, + 0, 384, 0, 420, 0, 453, 72, 87, 76, 77, + 80, 79, 68, 0, 73, 955, 982, 811, 0, 486, + 0, 0, 0, 85, 0, 86, 70, 330, 421, 891, + 84, 0, 78, 81, 0, 83, 0, 892, 82 +}; + +/* YYDEFGOTO[NTERM-NUM]. */ +static const yytype_int16 yydefgoto[] = +{ + -1, 1, 13, 14, 15, 16, 46, 17, 18, 33, + 279, 1305, 1306, 1497, 1609, 1591, 1307, 1671, 1308, 1587, + 1588, 1309, 1589, 1310, 1672, 1698, 1699, 1700, 340, 1312, + 1313, 1476, 341, 51, 52, 99, 100, 101, 170, 171, + 373, 374, 375, 371, 372, 912, 913, 914, 102, 172, + 173, 240, 1223, 1224, 241, 971, 174, 104, 558, 1083, + 242, 19, 20, 44, 68, 67, 70, 72, 71, 69, + 214, 215, 243, 244, 675, 415, 245, 246, 417, 974, + 1276, 221, 222, 223, 401, 247, 248, 106, 311, 107, + 292, 293, 479, 480, 994, 995, 767, 517, 518, 519, + 520, 765, 1036, 1037, 1040, 1041, 1266, 1438, 1575, 1576, + 731, 732, 249, 250, 733, 1236, 1237, 1238, 251, 406, + 252, 683, 407, 408, 409, 1198, 1199, 108, 109, 1047, + 522, 523, 524, 779, 1270, 1271, 782, 783, 792, 784, + 1455, 1456, 734, 110, 1049, 1274, 1404, 1405, 1406, 1407, + 1408, 1409, 1410, 1411, 1412, 1413, 1414, 1415, 1416, 1417, + 1450, 111, 525, 313, 527, 528, 112, 721, 493, 494, + 295, 296, 735, 297, 298, 486, 487, 998, 736, 1004, + 1232, 737, 738, 113, 114, 1054, 790, 1277, 1585, 115, + 272, 1206, 696, 697, 116, 117, 1055, 286, 793, 794, + 795, 796, 53, 119, 798, 534, 535, 1059, 1060, 120, + 1213, 985, 986, 121, 275, 276, 459, 1207, 699, 122, + 288, 1216, 476, 797, 495, 991, 1560, 715, 716, 1214, + 253, 538, 124, 857, 1127, 1128, 627, 896, 897, 1628, + 894, 125, 513, 126, 323, 127, 500, 489, 128, 129, + 130, 750, 751, 1023, 752, 175, 585, 1511, 1102, 1332, + 1333, 1629, 1508, 860, 861, 862, 1104, 1336, 1337, 1338, + 1339, 1064, 176, 605, 1522, 908, 1139, 1350, 1351, 254, + 255, 256, 257, 258, 425, 428, 259, 260, 447, 261, + 448, 262, 263, 264, 265, 266, 450, 452, 455, 267, + 1105, 1106, 268, 514, 354, 1419, 1204, 364, 365, 366, + 367, 177, 178, 320, 546, 547, 548, 549, 1241, 541, + 542, 1242, 179, 180, 384, 642, 938, 181, 643, 644, + 580, 939, 1169, 1170, 706, 324, 325, 182, 134, 135, + 560, 136, 280, 465, 326, 561, 562, 137, 138, 563, + 826, 139, 564, 565, 1084, 343, 183, 184, 569, 570, + 846, 847, 141, 571, 848, 1091, 185, 186, 386, 387, + 187, 1523, 1100, 388, 650, 944, 1178, 647, 940, 1174, + 1175, 1176, 188, 189, 190, 191, 192, 368, 628, 629, + 630, 193, 586, 1342, 874, 875, 1107, 898, 194, 919, + 1153, 1154, 195, 1161, 1368, 196, 1157, 1365, 197, 631, + 632, 633, 634, 1162, 1253, 1026, 1027, 1028, 1256, 1257, + 1567, 198, 602, 603, 199, 594, 595, 200, 1346, 1633, + 352, 888, 889, 377, 21, 331, 152, 22, 66, 577, + 1506, 1097, 1328, 153, 332, 333, 334, 54, 329, 55, + 1326, 1681, 574, 1619, 23, 56, 24, 65, 611, 612, + 1524, 1144, 1355, 851, 1095, 1324, 1620, 1621, 1622, 1623, + 529, 145, 283, 284, 146, 471, 472, 270, 694, 201, + 390, 945, 653, 1384, 202, 637, 271, 950, 951, 952, + 25, 26, 27, 28, 29, 657, 1541, 207, 955, 1387, + 1388, 659, 1644, 1188, 30, 31, 656, 205, 661, 1542, + 1190, 392, 655, 956, 957, 958, 203, 154, 575, 349, + 1080, 1586, 607 +}; + +/* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing + STATE-NUM. */ +#define YYPACT_NINF -1407 +static const yytype_int16 yypact[] = +{ + -1407, 1588, -1407, -1407, -1407, -2, 72, -1407, -1407, -1407, + 89, 749, -1407, -1407, 133, 216, -1407, -1407, -1407, -1407, + 719, -1407, 147, -1407, 147, 512, 623, -1407, -1407, 147, + -1407, 147, -1407, -1407, -1407, -1407, -1407, -1407, -1407, -1407, + -1407, -1407, -1407, 156, 163, 172, -1407, -1407, -1407, 628, + -1407, -1407, 4054, 232, 147, -1407, 493, 4345, 179, 258, + -1407, -1407, 4345, 4345, -1407, 77, 77, 181, 181, 181, + 181, 223, 181, 1558, -1407, -1407, -1407, -1407, -1407, -1407, + 77, 267, -1407, -1407, 101, 377, 456, 537, -1407, -1407, + 101, 115, -1407, -1407, 880, -1407, 581, -1407, 399, -1407, + 4054, -1407, -1407, 504, 827, 428, -1407, -1407, -1407, 458, + 432, -1407, -1407, -1407, 554, -1407, -1407, 513, 562, -1407, + -1407, -1407, -1407, 419, 708, -1407, 533, -1407, -1407, -1407, + -1407, -1407, -1407, -1407, -1407, -1407, -1407, -1407, -1407, -1407, + -1407, -1407, -1407, -1407, -1407, -1407, -1407, -1407, -1407, -1407, + 622, -1407, -1407, -1407, 591, 560, 568, 3614, 231, -40, + 268, 586, 592, -1407, 3801, 3825, 609, 626, 3638, 742, + 697, -1407, 4244, -1407, 1039, -1407, -1407, -1407, -1407, -1407, + -1407, -1407, -1407, -1407, -1407, -1407, -1407, 776, -1407, -1407, + -1407, -1407, -1407, -1407, -1407, -1407, -1407, -1407, -1407, -1407, + -1407, -1407, 639, -1407, -1407, 644, -1407, 648, 697, 697, + 133, 133, 663, 3041, -1407, -1407, -1407, -1407, -1407, 671, + 1458, -1407, -1407, -1407, -1407, -1407, -1407, -1407, -1407, -1407, + -1407, 3855, -1407, -1407, -1407, 666, 684, 3879, -1407, 103, + 866, -1407, -1407, -1407, 713, -1407, -1407, 428, -1407, 95, + -1407, -1407, 3855, -1407, -1407, 878, -1407, 859, 228, 1879, + 619, -1407, -1407, 902, 907, 899, 515, -1407, -1407, -1407, + -1407, 727, 746, 133, -1407, 109, -1407, -1407, 133, 438, + 77, 751, -1407, 112, -1407, -1407, 753, 761, 553, 133, + 77, 815, 768, 470, 501, 116, 239, -1407, -1407, -1407, + -1407, 302, -1407, -1407, 3638, 2820, 3879, 77, 951, 964, + 3879, 756, 263, -1407, 787, 456, 456, 360, 3908, 3879, + 835, 3879, 3879, 791, -1407, 4166, 528, 826, 896, 269, + -1407, -1407, -1407, 847, -1407, -1407, -1407, 3879, 3879, 96, + 399, -1407, -1407, 77, 77, 133, 77, -1407, -1407, -1407, + -1407, -1407, 811, 3502, -1407, 77, 3532, 77, -1407, 824, + 133, -1407, -1407, -1407, -1407, -1407, -1407, -1407, 77, 80, + 77, -1407, -1407, -1407, 4267, -1407, -1407, -1407, 3879, 813, + 3268, 3268, 2820, -1407, 602, 135, 79, -1407, -1407, 828, + 77, -1407, -1407, -1407, -1407, -1407, -1407, 1018, 832, 1558, + -1407, -1407, 1026, 1028, 126, 3855, 885, 1038, -1407, -1407, + -1407, 739, 739, 184, 869, -1407, 870, 872, 1879, 858, + 1558, 1558, -1407, 852, -1407, 1879, -1407, -1407, 1879, -1407, + -1407, 1879, 882, 859, -1407, -1407, -1407, -1407, -1407, -1407, + -1407, -1407, -1407, -1407, -1407, -1407, -1407, 515, 515, -1407, + 3879, -1407, 3879, -1407, -1407, 3879, -1407, 863, 883, 827, + 267, 133, 876, -1407, -1407, 1058, 133, 112, 751, 133, + -1407, 121, -1407, 1056, -1407, 889, 891, -1407, 133, 1081, + -1407, -1407, 77, -1407, 895, -1407, 1086, -1407, -1407, -1407, + -1407, -1407, -1407, -1407, 139, 880, 880, 564, 101, 101, + 1124, 133, 77, -1407, 111, -1407, -1407, -1407, 143, 898, + 133, 986, 3879, 903, 1099, -1407, 375, 937, 764, -1407, + -1407, 961, 921, 962, 1114, 77, -1407, 1116, -1407, -1407, + 931, 88, -1407, 930, 153, -1407, -1407, 92, 925, -1407, + -1407, -1407, -1407, 77, 1121, -1407, 127, 129, -1407, -1407, + 827, 77, 932, 824, -1407, -1407, 101, 1125, 1017, 4395, + -1407, -1407, -1407, -1407, 308, -1407, 254, -1407, 938, 843, + -1407, -1407, 998, -1407, 942, 77, 952, -1407, -1407, -1407, + 943, 945, 133, 133, 133, 824, 3340, 3119, 3879, -40, + 827, 827, 858, -1407, 145, -1407, 133, 3879, -40, 827, + 827, -1407, 152, -1407, 133, 824, -1407, 159, 133, 949, + 340, -1407, 965, -1407, 954, -1407, -1407, 1145, 3685, 2820, + 960, -40, -40, -40, 827, -1407, -1407, -1407, -1407, -1407, + -1407, 161, -1407, -1407, -1407, 165, 155, 320, 827, -1407, + -1407, -1407, 1113, -1407, -1407, -1407, -1407, 246, 963, -1407, + -1407, -1407, -1407, 3879, 133, 90, 77, 90, 971, -1407, + 973, -1407, 3879, -1407, 972, 1558, 3879, 3879, -1407, 1153, + 858, -1407, 3855, -1407, -1407, -1407, -1407, 405, 983, -1407, + -1407, -1407, -1407, -1407, -1407, -1407, -1407, 859, 228, 1140, + -1407, 902, 907, -1407, 3879, 1162, 166, -1407, 565, 1165, + -1407, -1407, 976, -1407, -1407, 3879, -1407, 3879, 133, -1407, + 753, 133, 824, 1151, 981, 1172, -1407, 815, 133, 985, + 501, 77, 880, -1407, -1407, 987, -1407, 1158, -1407, -1407, + 243, -1407, 993, -1407, -1407, 439, -1407, 1158, -1407, 1166, + 494, -1407, 133, 77, 133, 77, 1644, -40, 3879, 144, + 167, -1407, -1407, 105, -1407, 133, 3941, 133, 1088, 3879, + 77, -1407, 3879, 549, -1407, 824, 410, -1407, -1407, -1407, + -1407, 1000, -1407, 1001, -1407, -1407, -1407, -1407, -1407, -1407, + -1407, -1407, 1192, -1407, 1003, -1407, 961, 133, 787, 1005, + 1199, -1407, -1407, -1407, 1200, -1407, -1407, -1407, 77, 1013, + 458, 133, 1014, 133, 3879, 3879, -1407, 3879, 1060, -1407, + 77, 133, -1407, -1407, 133, 77, 1040, 411, 1015, 3986, + 1019, 914, -1407, -1407, -1407, -1407, -1407, -1407, -1407, -1407, + -1407, -1407, -1407, -1407, -1407, -1407, -1407, -1407, -1407, 826, + -1407, -1407, 1072, 3879, 454, -1407, 668, -1407, -1407, -1407, + -1407, 1059, 1211, 133, 1101, 726, -1407, -1407, -1407, -1407, + 1213, -1407, 1024, 3879, 3879, 3879, 3879, 3879, 1214, 3879, + -40, 3879, 827, -1407, 171, -1407, 3879, 1217, 827, 827, + 827, 827, 3879, 827, -40, 827, 827, -1407, 178, -1407, + -1407, -1407, -1407, -1407, -1407, -1407, -1407, -1407, -1407, 3502, + 77, -1407, -1407, -1407, -1407, 3532, 77, -1407, 1215, 824, + -1407, 3879, -1407, 848, -1407, -1407, -1407, 1193, 1834, 3585, + 3879, -1407, -1407, -1407, -1407, -1407, -1407, -1407, -1407, -1407, + 3268, 3941, 920, 920, 133, -1407, -1407, 3879, 910, -1407, + 1710, 77, 133, -1407, 77, 77, 103, 1221, -1407, -1407, + 186, -1407, -1407, -1407, -1407, -1407, 1033, 1226, -1407, 133, + 1037, 1201, 1205, 1042, -1407, 187, 191, 1044, 3855, -1407, + -1407, -1407, -1407, -1407, 1045, 192, 3879, 883, -1407, 827, + 3879, 1047, 1239, -1407, -1407, 1240, -1407, -1407, -1407, -1407, + 891, 435, -1407, -1407, 195, -1407, 154, -1407, 1242, -1407, + 133, -1407, 1558, 997, -1407, -1407, 3716, 564, -1407, -1407, + -1407, -1407, 133, 133, 3879, 1241, -1407, -1407, 3747, 1124, + -1407, 1849, 3879, -1407, 3941, -1407, 194, -1407, -1407, 77, + 1050, 133, -1407, -1407, 1057, -1407, 376, -1407, -1407, 1064, + 196, -1407, 77, 133, -1407, -1407, 921, 77, -1407, 1232, + -1407, -1407, -1407, 1067, 77, 77, 88, 133, 1245, 203, + -1407, -1407, -1407, -1407, -1407, -1407, 1255, -1407, 1258, -1407, + 827, 133, 133, 101, 77, 133, 3879, 3077, 3018, 3426, + -1407, 824, 3879, 4368, -1407, 826, 1073, 77, 133, 476, + -1407, -1407, -1407, -1407, 86, -1407, -1407, 1077, 133, -1407, + 77, 408, 1083, 3879, -1407, -1407, -1407, -1407, -1407, -1407, + -1407, -1407, 3879, -1407, -1407, -1407, -1407, 3340, -1407, -1407, + 827, 1085, -1407, -1407, -1407, -1407, -1407, -1407, -1407, -1407, + -1407, -1407, 3371, -1407, -1407, 133, -1407, 133, 464, 1087, + -1407, 1090, -1407, -1407, 1080, -1407, 1144, 224, 1270, 3879, + -40, 827, -1407, 206, -1407, -1407, -1407, 77, 1279, 3941, + -1407, 77, 1283, -1407, -1407, 198, 1097, 523, 526, -1407, + -1407, 602, 3879, -1407, 209, -1407, 1288, 133, 77, 133, + 133, 3879, 3879, -1407, -1407, 90, 1267, -1407, 1077, -1407, + 1077, -1407, 1202, -1407, 1227, -1407, -1407, 154, 1100, 1298, + -1407, -1407, -1407, -1407, -1407, -1407, 77, 210, -1407, 1110, + -1407, 3879, 824, 201, 2127, -1407, 77, 553, 985, 77, + 3879, 405, 578, -1407, -1407, -1407, -1407, -1407, -1407, -1407, + -1407, -1407, -1407, -1407, -1407, 1300, 211, -1407, -1407, 1107, + -1407, -1407, -1407, -1407, -1407, 3879, -40, -1407, -1407, 3879, + 1306, -1407, 858, -1407, -1407, -1407, 1310, -1407, 3941, 133, + 133, 1218, 2219, 549, -1407, 2219, 1232, 824, 133, 133, + 2127, 732, -1407, 133, 2127, 671, 142, 2127, 1127, 133, + 133, -1407, 1131, 1013, -1407, -1407, 3879, 77, 133, 77, + 133, 1129, 3879, -1407, -1407, -1407, -1407, -1407, 527, 612, + 544, 769, 786, 616, 640, 1132, 3879, 1119, -1407, 827, + 1134, 566, 1137, 892, 1782, 212, 1135, -1407, 1228, 133, + 77, 133, 1328, 1189, 1334, -1407, 77, -1407, -1407, 133, + 827, 1333, 1336, -1407, -1407, -1407, 218, -1407, 3879, 1337, + -1407, -1407, 77, -1407, 3941, -1407, 77, 827, 1335, -1407, + 1340, -1407, -1407, -1407, -1407, -1407, 3879, -40, 3879, -1407, + -1407, -1407, 3585, 77, 133, 77, 133, 920, 77, 133, + 536, 77, 133, 77, 133, 602, -1407, 1710, -1407, 3879, + 133, 399, -1407, -1407, 77, -1407, 1152, -1407, -1407, -1407, + -1407, 1339, 1341, -1407, 3879, 133, 827, -1407, -1407, 1344, + -1407, 133, 1326, -1407, 1155, 1348, -1407, 1349, -1407, 1351, + -1407, 1352, -1407, -1407, 3879, 1331, 1355, -1407, -1407, 1356, + 133, -1407, -1407, 133, 1358, -1407, -1407, 3908, 3908, -1407, + -1407, -1407, -1407, 3879, 3941, -1407, 77, -1407, 1168, 1362, + 1363, 1352, -1407, 1174, 188, -1407, 1175, -1407, -1407, -1407, + 1176, 1177, -1407, 3879, 642, -1407, -1407, 1178, -1407, -1407, + -1407, 133, 133, 651, -1407, -1407, -1407, -1407, -1407, -1407, + 976, -1407, 100, -1407, -1407, 1173, -1407, -1407, 2686, 3879, + 3879, 3879, 3879, 3879, 3879, 3879, 3879, 3879, 3879, 3879, + 3879, 3879, 3879, 2583, 3879, 2710, 2783, -1407, -1407, 4368, + 539, 133, 1182, 1183, 1184, 133, 77, -1407, -1407, 827, + 47, 77, 3879, -1407, -1407, -1407, 133, 1279, 133, -1407, + 827, 348, 77, 77, 77, 1186, 1373, -1407, -1407, 133, + 133, -1407, 133, 77, 133, 133, 133, -1407, -1407, 133, + 1187, 77, -1407, 77, 3879, 1558, 1378, -1407, 3879, 1191, + -1407, 3879, 3771, 2347, 1379, 1382, 1338, -1407, -1407, 3879, + 891, 3879, -1407, -1407, -1407, 1384, -1407, 1196, 133, -1407, + 3879, 3879, -1407, 3879, 642, -1407, -1407, -1407, -1407, -1407, + -1407, -1407, -1407, -1407, -1407, 2127, 45, -1407, -1407, -1407, + 3879, -1407, -1407, -1407, -1407, -1407, -1407, -1407, -1407, -1407, + -1407, -1407, -1407, -1407, -1407, -1407, -1407, 3879, 3879, -1407, + -1407, -1407, 3879, -1407, 3879, -1407, 77, 133, 1189, -1407, + -1407, 1388, -1407, -1407, -1407, -1407, -1407, 133, -1407, -1407, + -1407, 133, -1407, 77, -1407, -1407, 133, 133, 133, 4368, + -40, 133, 1198, 133, 77, 133, 1203, 1204, 3879, -1407, + 1365, -1407, -1407, -1407, -1407, 1389, -1407, -1407, -1407, -1407, + -1407, 1172, 220, 3879, -1407, -1407, -1407, -1407, 1206, 1119, + 1208, 2394, 1209, 1210, 1219, -1407, -1407, -1407, -1407, -1407, + 133, 77, 1182, 133, 77, -1407, 133, -1407, -1407, 1391, + 824, -1407, 3879, -1407, 1392, -1407, -1407, 2466, 1399, -1407, + -1407, 1401, -1407, 827, -1407, 133, -1407, 133, 3879, -1407, + 1220, 3879, 3879, 1403, 2394, 3879, -1407, -1407, -1407, 1405, + -1407, 3879, -1407, 1407, 3879, -1407, 3879, -1407, -1407 +}; + +/* YYPGOTO[NTERM-NUM]. */ +static const yytype_int16 yypgoto[] = +{ + -1407, -1407, -1407, 917, -1407, 1360, 629, -1407, -1407, -1407, + -1407, -1407, -1407, -1407, -1407, -1407, -168, -1407, -1407, -1407, + -1407, -1407, -1407, -1407, -613, -1407, -286, -1407, -11, -1407, + -1407, -1407, -1407, -1407, -1407, -1407, -1407, 1327, 922, -1407, + -1407, -1407, -174, 780, -1407, -1407, -1407, 516, -1407, -72, + -895, -631, -1407, -1407, 423, 429, -45, 49, -1407, 672, + -215, -78, -1407, 1411, -1407, -1407, -1407, -1407, -1407, -1407, + 979, -1407, -219, -194, 1021, -425, -121, -1407, -1407, -1407, + 168, -1407, -1407, -1407, 160, -33, -1407, -1407, -1407, -1407, + -1407, -1407, -1407, 720, -1407, 221, -1407, -1407, -1407, 918, + -1407, -1407, -1407, 175, -1407, 173, -1407, 176, -1407, -1407, + -958, 1432, -1407, 1023, 442, -1407, 18, 20, -1407, 1197, + -1407, -1407, 1043, -612, -1407, -1407, -1407, -1407, -1407, -1407, + -1407, -1407, -1407, 664, -1407, -1407, -1407, 407, -1407, -1407, + -1407, -1407, -956, -276, -1407, -1407, -1186, -454, -907, -1163, + -828, -1407, -98, -441, -97, -1407, -1407, 42, -1407, -100, + -1407, -1407, -1407, -1407, -1407, 670, -1407, -1407, -1407, -1407, + -403, -1407, -1407, 967, -238, -1407, 741, -1407, 457, -599, + -1407, 462, -1407, -1407, -1407, -1407, -1407, -1407, -1407, -1407, + -1407, -1407, -1407, 490, -1407, -1407, -1407, -16, -1407, -1407, + 414, -1407, 7, -1407, -1407, -1407, 674, -1407, 189, -1407, + -1407, -210, 259, -1407, -1407, 1022, -1407, -1407, -925, -1407, + -1407, -1407, -1407, -268, -468, -1407, -1407, -77, 495, -1407, + 1497, -1407, 1316, -455, 598, -1407, -1407, -803, -1407, -556, + -1407, -451, -287, -281, -1407, 933, -1407, -1407, -273, -288, + -1407, -1407, 471, -1407, -1407, 934, -1407, -1407, -1407, -1407, + -21, -29, 148, -1407, 393, -568, -1407, -1407, -15, -1407, + -269, 158, 940, -1407, -1407, -1407, -1407, -1407, -20, -1407, + -1407, 431, -87, 1053, -1407, -1407, -115, 1054, -1407, 1237, + -1407, 1055, 1052, 1051, -1407, -1407, -1407, -1407, -1407, 1771, + -786, -152, -165, 745, -37, -1046, -1330, -1407, -1407, -211, + -1407, -51, 416, -1407, -1407, -1407, 705, 704, -506, 711, + -1407, 1207, -372, -370, -842, -1407, -1407, -1407, -1407, -822, + -820, -1407, -1407, -1407, -1407, -101, -1407, 481, -1407, -1407, + 953, -1407, -80, -693, -108, 1194, -1407, -1407, -1407, -1407, + -1407, -1407, -1407, 955, -1407, -1407, -1407, 517, -1407, -503, + -1407, -1407, -1407, -1407, -1407, -1407, 959, -1407, -1407, 1138, + -1407, -1407, -1407, -1407, -1407, -1407, -1407, -1407, -1407, -1407, + 146, -1085, -1407, 969, -1407, -14, -1407, -1407, 908, -107, + -1407, 970, -1407, -1407, -1407, 403, 654, 935, 977, -1407, + -1407, 170, 978, -1407, -1407, 980, -1407, -1407, -10, 1157, + 923, 610, -232, 611, -863, -878, -943, -858, -1407, 108, + -1407, 988, -1407, 641, 991, -1407, 646, 992, -1407, -1407, + -1407, -1407, 424, 525, -1407, -1407, -1407, -1407, -1407, -1407, + -1407, -1407, -339, -1407, -1407, -1407, 1222, -1407, -1407, 1503, + -1407, -1407, -1407, -1407, -1407, 645, -1407, -1407, -1407, -1407, + -1407, -1407, -1407, -1407, -1407, -1407, -1012, -1407, -124, -1407, + -1406, -1407, 1280, 1095, -1407, -1407, 855, -488, -1407, 1007, + -1407, -1407, -1407, -1407, -1407, -1407, 939, 873, 386, 389, + -1407, -1407, 1545, -137, -1407, -1407, -1407, -1407, -1407, -1407, + -1407, -1407, -1407, -1407, -122, -1407, -1407, -1407, -1407, 182, + -1407, -1407, -1407, 924, -1407, 395, 546, -1407, -1407, -1407, + -1407, -1407, 502 +}; + +/* YYTABLE[YYPACT[STATE-NUM]]. What to do in state STATE-NUM. If + positive, shift that token. If negative, reduce the rule which + number is the opposite. If YYTABLE_NINF, syntax error. */ +#define YYTABLE_NINF -1021 +static const yytype_int16 yytable[] = +{ + 43, 131, 398, 363, 700, 404, 491, 103, 701, 741, + 290, 150, 640, 488, 641, 481, 362, 335, 414, 105, + 477, 490, 947, 1145, 105, 400, 722, 999, 327, 105, + 105, 312, 336, 1099, 893, 552, 269, 907, 142, 429, + 328, 98, 143, 903, 810, 1229, 98, 1231, 363, 131, + 544, 98, 98, 1158, 1208, 103, 485, 355, 357, 118, + 969, 105, 239, 947, 430, 432, 845, 105, 929, 1163, + 1163, 105, 728, 508, 1164, 1164, 1122, 1123, 1108, 1109, + 1110, 1254, 1325, 98, 1446, 1115, 142, 1376, 1451, 98, + 143, 1457, 723, 98, 314, -522, 1624, 1171, 421, 1440, + 376, 4, 1440, -539, 277, 151, 474, 118, -182, 1021, + 475, 953, 460, 1322, -195, 468, 416, 1166, 291, 492, + -763, -539, 418, 1580, 710, 4, 385, 89, 609, 667, + 805, 1005, 807, 4, 414, -195, 4, 414, 1009, 105, + -409, 8, 492, 431, 1330, 4, 756, 1453, 899, 1018, + 636, 554, 97, 507, 1296, 905, 800, 47, 933, -729, + -763, 98, 909, -410, 930, 8, 1255, 4, 930, 977, + 1019, 703, 433, 8, 1117, -195, 8, 4, 702, 4, + -409, 1132, 32, 269, 664, 8, 414, 825, 1317, 1182, + 1192, 498, 1331, 1573, 1194, 1182, 335, 1258, 1218, 1267, + 613, 1367, 212, -410, 492, 680, 1283, 8, 346, 1362, + 648, 336, 1377, 1396, 1428, 909, 1254, 8, 4, 8, + 4, 1512, 4, 1692, 432, 4, 413, 1357, 507, 507, + 507, 684, 416, 516, 684, 416, 42, 432, 418, 533, + 49, 418, 496, 1665, 219, 780, 593, 227, 228, 601, + 499, 1555, 973, 376, -539, 4, 1291, 987, 8, 1022, + 8, 497, 8, 34, 1003, 8, 521, 502, 464, -266, + 4, 645, 572, 515, 12, 1200, 1624, 1323, 726, 42, + 35, 954, 545, 98, 416, 515, -522, 651, 1454, 422, + 418, -522, 105, -763, 1538, 8, 302, 678, 12, 530, + 531, 1255, 376, 727, 858, -195, 12, -473, -195, 12, + 8, 412, 859, -409, 98, 1435, 1116, 1343, 12, 1001, + 668, 806, 1121, 808, 858, 1124, 1340, 1375, 646, 1130, + 48, 433, 859, 639, 1574, 754, -410, 302, 576, 900, + 12, 105, 413, 1090, 687, 413, 906, 302, 606, 73, + 12, 105, 12, 910, 505, 931, 969, 74, -236, 932, + 978, 1020, 269, 98, 47, 1118, 75, -197, 1557, -1019, + 204, -1019, 1133, 98, 213, 1235, 729, 302, 763, 1263, + 1183, 1193, 740, 269, 269, 1195, 1202, 923, 1440, 1219, + 1655, 12, 148, 12, 413, 12, 1555, 1284, 12, 1668, + 1363, 658, 660, 1378, 1397, 1429, 1498, 1440, 92, 93, + 239, 95, 1513, 498, 1693, 42, 220, -337, 743, 745, + 236, 89, 344, 573, 227, 228, 105, 9, 12, 505, + 505, 505, 491, 638, 4, 4, 310, 941, 492, 488, + 516, 481, 1007, 12, 230, 1347, 97, 490, 698, 206, + 965, 963, 839, -507, 60, 966, 967, -507, 972, 347, + 274, 1008, 105, 105, 730, 348, 1517, 507, 132, 429, + 849, 1547, 499, 915, 8, 8, 815, 556, 4, 873, + 887, 890, 485, 430, 98, 98, 725, 1038, 916, 749, + 901, 1254, 1626, 1348, 430, 234, 1581, 363, 1582, 557, + 4, 363, 363, 532, 1531, 1330, 1653, 1557, 824, 1164, + 780, 42, 11, 1557, 821, 741, 132, 105, 8, 741, + 791, 842, -137, 1217, 700, 1653, 105, 1507, 701, 764, + 1264, 281, 11, 133, 227, 228, 1066, 48, 1068, 98, + 8, 58, 98, 59, 1507, 829, 1010, 4, 98, 834, + 4, 947, 829, 1331, 462, 463, 729, 105, 105, 287, + 4, 1347, 740, 4, 1287, 318, 105, 105, 282, 140, + 1349, 474, 1527, 431, 698, 475, 1255, 144, 1228, 98, + 98, 133, 728, 227, 228, 301, 285, 8, 98, 98, + 8, 105, 302, 235, 698, 1361, 42, 236, 147, 42, + 8, 1042, 1074, 8, 1145, 105, 304, 12, 12, 1348, + 285, 305, 319, 98, 306, 151, 1666, 140, 1667, 1011, + -1019, 310, -1019, -463, 483, 144, 935, 98, 269, 42, + 11, 434, 435, 436, 437, 438, 439, 440, 891, 230, + 155, 1099, 946, 307, 1651, 1087, 147, 902, 82, 83, + 1033, 12, -1020, 316, -1020, 42, 5, -1019, 6, -1019, + 89, 484, 64, 1651, 231, 7, 970, 1320, 505, 57, + 926, 927, 928, 12, 62, -932, 63, 76, 9, 1034, + 232, 233, 235, 946, 315, 97, 236, 1035, 230, 105, + 234, 703, 42, 1209, 294, 308, 555, 556, 702, 92, + 93, 984, 95, 235, 317, 60, 42, 236, 237, 996, + 9, 98, 357, 321, 1371, 9, 238, 1373, -89, 557, + 12, -89, 533, 12, 1652, 515, 322, 1533, -97, -97, + 1616, -97, 1085, 12, 330, -97, 12, 60, -97, 234, + -236, 1565, 10, 1652, 1145, 1402, 369, 1092, 92, 93, + 4, 95, 235, 337, 1039, 42, 236, 987, 302, 1472, + 1473, 338, 1113, 11, -538, -61, 230, 1065, 545, 89, + 545, 1002, 568, -943, 1089, 1125, 915, -538, 507, 350, + 441, 442, 443, 444, 1227, 351, 92, 93, 726, 95, + 8, 916, 593, 42, 97, 11, 1016, 1235, 601, 640, + 11, 641, 358, -90, 639, 414, -90, -93, 1439, 370, + -93, 1439, 1152, 727, 445, 446, 411, 234, 89, 359, + 858, 1441, 105, 385, 1441, 77, 92, 93, 859, 95, + 1111, -92, 389, 42, 1465, 92, 93, 391, 95, 105, + 412, 393, 42, 97, 98, 105, 105, 105, 105, 1389, + 105, 1390, 105, 105, 754, 396, 685, 858, 1469, 686, + 414, 98, 1477, 236, 399, 859, 411, 98, 98, 98, + 98, 420, 98, 1146, 98, 98, -1019, -1019, -1019, -1019, + 426, 427, 416, 1155, 412, 105, 729, -223, 740, 1447, + 1448, 1449, 740, 89, 36, 37, 38, 39, 1140, 105, + 105, 424, 40, 416, 638, 453, 454, 98, 41, 418, + 92, 93, 449, 95, 82, 83, 451, 42, 97, 1114, + 457, 98, 98, 12, 36, 37, 38, 39, 11, -276, + 673, 674, 40, 1129, 9, 9, 11, -277, 41, 458, + 42, 700, 282, 515, 470, 701, 105, 568, 844, 1421, + 1167, 1168, 473, -100, -100, 511, -100, 1197, 416, 482, + -100, 60, 60, -100, 418, 269, 741, 1147, 698, 512, + -99, -99, 601, -99, 730, 1673, 1674, -99, 526, 505, + -99, 550, 210, 211, 208, 209, 769, 1038, 394, 395, + 553, 239, 1222, 1289, 555, 239, 725, 273, 559, 566, + 568, 278, 1426, 640, 587, 641, 615, 289, 749, 1424, + 873, 92, 93, 413, 95, 42, 227, 228, 42, 11, + 11, 305, 652, 662, 1082, 887, 663, 430, 1470, -944, + -138, 665, 1470, 666, 379, 671, 380, 105, 1146, 381, + 382, 672, 1359, -234, -229, 791, 677, 216, 217, 218, + 105, 224, 679, 307, 682, 363, -224, 693, 383, 98, + 82, 83, 770, 707, 92, 93, 545, 95, 1311, 705, + 606, 42, 98, 294, 695, 345, 1475, 93, 712, 95, + 713, 400, 714, 42, 717, 360, 741, 105, 719, 720, + 698, 771, 758, 772, 773, 774, 759, 761, 775, 776, + 729, 777, 778, 762, 92, 93, 740, 95, 703, 98, + 766, 42, 781, 1159, 105, 702, 785, 786, 105, 788, + 639, 230, 789, 799, 802, 804, 812, 698, 746, 816, + 817, 843, 850, 852, 854, 226, 98, 855, 105, 856, + 98, 304, 911, 227, 228, 747, 305, 917, 918, 378, + 920, 924, 937, 961, 943, 962, 968, -230, 440, 379, + 98, 380, 232, 233, 381, 382, 964, 976, 979, 980, + 1381, 946, 234, 988, 989, 990, 993, 1418, 307, 1003, + 1002, 92, 93, 383, 95, 235, 1006, -446, 42, 236, + 1221, 1029, 461, 1044, 1045, 1046, 1048, 466, 1052, 1360, + 469, 984, 1053, 1056, 1058, 1062, 1070, 478, 1076, 1073, + 1425, 307, 1081, 1093, 1094, 1096, 1101, 1103, 1138, 1112, + 638, 501, 1120, 1143, 510, 1418, 1181, 1184, 1418, 1185, + 308, 1186, 1187, 1418, 1189, 987, 1191, 1418, 1196, 1201, + 1418, 1210, 1211, 1212, 1261, 1245, 304, 1220, 230, 1065, + 1262, 305, 1716, 1275, 1356, 1152, 1039, 1265, 1278, 1285, + 582, 583, 1286, 584, 379, 1282, 380, 1318, 1327, 381, + 382, 1354, 596, 231, 604, 1358, 105, 1335, 748, 1344, + 105, 1352, 1258, 307, 1353, 608, 1367, 610, 383, 232, + 233, 1370, 1379, 1386, 1393, 1431, 1391, 105, 98, 234, + 1392, 1065, 98, 1394, 1398, 1427, -521, 654, 92, 93, + 1433, 95, 235, 1434, 105, 42, 236, 237, 1468, 98, + 1458, 1436, 1459, 1463, 639, 238, 1466, 1471, 1474, 1499, + 1647, 1500, 1502, 1646, 105, 1503, 98, 1504, 1509, 1510, + 1520, 1515, 105, 1521, 1544, 1540, 1545, 1548, 1549, 1550, + 1662, 1551, 1558, 1552, 1553, 1554, 98, 1546, 1559, 1659, + -379, 1561, 1569, 105, 98, 1570, -255, 1571, 1572, 1577, + 1578, 1579, 1584, 1618, 1625, 1323, 1640, 1418, 1642, 363, + 1639, 1648, 1650, 1437, 708, 698, 1658, 1690, 711, 1663, + 1664, 1682, 1685, 1691, 1708, 1711, 363, 1687, 1688, 718, + 1695, 1696, 1714, 1702, 1703, 1715, 1526, 1721, 1724, 78, + 300, 1726, 639, 1704, 1718, 742, 744, 239, 1669, 755, + 309, 105, 1470, 1197, 638, 757, 1225, 303, 1722, 1142, + 105, 50, 1226, 676, 1444, 1452, 768, 992, 1442, 1422, + 1445, 1443, 787, 45, 681, 1230, 1563, 1562, 669, 423, + 1050, 801, 98, 1272, 1146, 1656, 1556, 1657, 1051, 1660, + 803, 997, 225, 724, 1243, 1233, 105, 1205, 811, 226, + 1281, 1400, 1460, 814, 1061, 545, 105, 227, 228, 229, + 1709, 1710, 704, 1661, 1131, 1215, 813, 105, 98, 1630, + 1248, 1634, 853, 822, 1334, 1519, 1514, 1632, 98, 823, + 688, 1635, 689, 456, 691, 690, 692, 1032, 269, 98, + 1067, 1069, 638, 1063, 1418, 1418, 1418, 840, 827, 841, + 1341, 567, 1418, 1537, 649, 543, 922, 363, 828, 830, + 1119, 402, 1528, 1418, 1418, 904, 831, 832, 635, 833, + 1156, 105, 1566, 925, 1165, 1134, 1136, 835, 1418, 123, + 836, 837, 403, 934, 123, 578, 1345, 149, 1706, 123, + 123, 467, 225, 709, 942, 983, 838, 975, 1383, 226, + 1382, 61, 1543, 959, 0, 1670, 936, 227, 228, 229, + 1385, 960, 230, 1315, 0, 0, 0, 0, 2, 3, + 0, 299, 0, 0, 1146, 0, 0, 123, 0, 0, + 0, 299, 0, 0, 0, 0, 105, 231, 0, 0, + 0, 1689, 4, 0, 0, 0, 5, -1019, 6, -1019, + 0, 0, 0, 232, 233, 7, 1694, 0, 98, 0, + 0, 0, 0, 234, 539, 0, 0, 0, 1000, 0, + 0, 0, 92, 93, 0, 95, 235, 0, 1014, 42, + 236, 237, 8, 0, 0, 226, 0, 0, 0, 238, + 1012, 0, 1013, 227, 228, 0, 0, 0, 0, 123, + 105, 1717, 0, 0, 1719, 9, 0, 1031, 0, 984, + 0, 0, 230, 1043, 0, 0, 0, 1727, 1147, 1684, + 0, 0, 98, 0, 0, 0, 626, 626, 0, 0, + 0, 0, 10, 0, 0, 0, 0, 231, 0, 0, + 0, 0, 0, 0, 1172, 1057, 0, 0, 0, 0, + 0, 226, 0, 232, 233, 0, 0, 1071, 0, 227, + 228, 0, 1072, 234, 1075, 0, 0, 0, 0, 0, + 0, 0, 92, 93, 0, 95, 235, 0, 0, 42, + 236, 237, 0, 0, 0, 0, 0, 0, 0, 238, + 11, 1088, 0, -202, -202, -202, -202, 0, 230, 0, + 0, -202, 1098, 0, 0, 0, 0, -202, 0, 0, + 0, 0, 0, 0, 0, 12, 0, 1478, 1479, 1480, + 1481, 1482, 1483, 231, 1484, 1485, 1486, 1487, 1488, 1489, + 0, 1490, 1491, 1492, 1493, 1494, 0, 0, 0, 232, + 233, 300, 300, 0, 0, 537, 0, 1135, 0, 234, + 0, 0, 123, 1137, 0, 0, 0, 0, 92, 93, + 0, 95, 235, 0, 230, 42, 236, 237, 0, 0, + 0, 0, 0, 0, 0, 238, 0, 0, 0, 0, + 0, 0, 0, 1249, 0, 0, 0, 0, 1177, 231, + 226, 1179, 1180, 0, 0, 0, 809, 0, 227, 228, + 0, 123, 818, 0, 0, 232, 233, 537, 537, 0, + 0, 299, 0, 0, 0, 234, 0, 0, 0, 0, + 0, 0, 0, 0, 92, 93, 0, 95, 235, 0, + 0, 42, 236, 237, 0, 0, 892, 895, 0, 0, + 0, 238, 157, 0, 0, 892, 895, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 158, 342, 0, + 0, 0, 0, 0, 626, 0, 0, 1029, 0, 361, + 892, 0, 159, 1259, 0, 0, 1260, 0, 0, 160, + 0, 0, 161, 162, 309, 163, 0, 1268, 164, 1269, + 0, 165, 166, 167, 1273, 0, 0, 0, 0, 948, + 0, 1279, 1280, 230, 0, 0, 679, 1495, 1496, 0, + 0, 0, 0, 0, 0, 0, 0, 168, 0, 0, + 1288, 1290, 299, 299, 739, 0, 0, 0, 231, 0, + 0, 89, 410, 230, 1319, 0, 1321, 0, 419, 0, + 948, 0, 0, 0, 232, 233, 0, 1329, 92, 93, + 0, 95, 0, 410, 234, 42, 97, 0, 231, 0, + 0, 0, 0, 92, 93, 0, 95, 235, 300, 0, + 42, 236, 237, 0, 232, 233, 0, 299, 0, 0, + 238, 0, 0, 0, 234, 0, 299, 0, 0, 0, + 0, 0, 0, 92, 93, 0, 95, 235, 0, 0, + 42, 236, 237, 0, 1364, 0, 506, 509, 1366, 0, + 238, 0, 1369, 0, 1372, 1374, 0, 299, 299, 540, + 0, 0, 551, 0, 0, 1380, 299, 299, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 579, 581, + 0, 0, 0, 0, 0, 537, 0, 0, 0, 0, + 0, 299, 0, 1395, 592, 0, 0, 592, 0, 0, + 1401, 1403, 0, 1420, 0, 299, 1423, 0, 226, 0, + 0, 0, 0, 0, 0, 0, 227, 228, 0, 614, + 537, 361, 361, 506, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 670, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 892, 0, + 0, 537, 0, 0, 892, 895, 895, 892, 0, 1126, + 0, 892, 1126, 0, 1461, 0, 1462, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 299, + 0, 0, 0, 1437, 0, 0, 0, 0, 0, 0, + 226, 0, 0, 0, 0, 0, 0, 1501, 227, 228, + 0, 0, 0, 1505, 0, 0, 626, 0, 1160, 1160, + 0, 230, 0, 0, 0, 0, 0, 0, 0, 1516, + 0, 0, 0, 1518, 0, 0, 0, 0, 0, 0, + 0, 753, 0, 0, 0, 0, 231, 0, 0, 0, + 1529, 0, 1530, 760, 0, 1532, 0, 1534, 1535, 0, + 1536, 0, 232, 233, 0, 0, 0, 0, 0, 0, + 0, 1539, 234, 0, 0, 0, 0, 0, 0, 0, + 0, 92, 93, 0, 95, 235, 0, 0, 42, 236, + 237, 0, 1239, 0, 0, 0, 0, 0, 238, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 1160, 0, 0, 230, 0, 0, 0, 0, 0, 0, + 0, 1654, 299, 1568, 0, 0, 0, 0, 226, 0, + 0, 0, 0, 0, 0, 0, 227, 228, 231, 299, + 0, 0, 0, 0, 0, 299, 299, 299, 299, 0, + 299, 0, 299, 299, 232, 233, 809, 0, 0, 0, + 506, 0, 0, 0, 234, 0, 0, 0, 1697, 0, + 0, 0, 0, 92, 93, 226, 95, 235, 0, 0, + 42, 236, 237, 227, 228, 123, 0, 1617, 0, 0, + 238, 0, 0, 1627, 949, 0, 0, 537, 1631, 299, + 299, 0, 0, 0, 0, 0, 895, 0, 0, 1636, + 1637, 1638, 0, 410, 0, 0, 0, 0, 0, 0, + 1641, 0, 0, 0, 0, 0, 0, 0, 1643, 0, + 1645, 0, 0, 309, 0, 949, 0, 892, 0, 0, + 1712, 230, 0, 0, 0, 1160, 981, 226, 982, 0, + 0, 0, 0, 0, 0, 227, 228, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 231, 948, 948, 0, + 739, 0, 0, 537, 739, 0, 0, 0, 0, 0, + 0, 0, 232, 233, 0, 0, 0, 1015, 230, 1017, + 0, 537, 234, 0, 0, 0, 0, 1025, 0, 0, + 1030, 92, 93, 1680, 95, 235, 0, 0, 42, 236, + 237, 0, 0, 231, 0, 0, 0, 0, 238, 0, + 1683, 0, 0, 0, 0, 0, 0, 0, 0, 232, + 233, 1686, 0, 0, 0, 0, 0, 299, 0, 234, + 0, 0, 0, 0, 0, 0, 0, 0, 92, 93, + 123, 95, 235, 0, 0, 42, 236, 237, 1607, 0, + 230, 0, 0, 0, 226, 238, 0, 0, 1705, 0, + 0, 1707, 227, 228, 0, 1608, 0, 0, 0, 0, + 0, 0, 0, 0, 1086, 231, 0, 299, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 232, 233, 0, 506, 506, 506, 506, 0, 0, + 0, 234, 506, 0, 299, 0, 895, 506, 299, 0, + 92, 93, 0, 95, 235, 0, 537, 42, 236, 237, + 0, 0, 0, 895, 0, 0, 0, 238, 299, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 537, 537, + 0, 0, 1141, 1160, 0, 0, 0, 0, 0, 0, + 0, 1590, 0, 0, 0, 0, 0, 226, 0, 0, + 0, 361, 1025, 0, 0, 227, 228, 230, 579, 0, + 0, 1173, 0, 0, 0, 1612, 0, 0, 0, 0, + 0, 226, 0, 0, 0, 0, 0, 0, 0, 227, + 228, 0, 231, 0, 0, 0, 0, 0, 0, 410, + 0, 0, 0, 1239, 1239, 0, 0, 1203, 232, 233, + 1160, 0, 0, 0, 0, 0, 0, 0, 234, 0, + 0, 0, 0, 0, 0, 0, 0, 92, 93, 0, + 95, 235, 0, 0, 42, 236, 237, 1240, 0, 0, + 0, 0, 0, 0, 238, 1244, 0, 0, 1614, 1247, + 753, 0, 1250, 1251, 226, 1252, 0, 0, 0, 0, + 0, 0, 227, 228, 0, 0, 0, 0, 0, 0, + 230, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 892, 0, 299, 0, 0, + 0, 226, 0, 0, 230, 231, 892, 0, 0, 227, + 228, 503, 0, 0, 299, 0, 0, 579, 0, 0, + 1314, 232, 233, 1316, 0, 0, 0, 0, 0, 231, + 0, 234, 0, 0, 299, 0, 0, 0, 0, 0, + 92, 93, 299, 95, 235, 232, 233, 42, 236, 237, + 0, 0, 0, 506, 0, 234, 0, 238, 0, 0, + 0, 0, 0, 0, 92, 93, 0, 95, 235, 0, + 0, 42, 236, 237, 0, 0, 0, 230, 0, 0, + 0, 238, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 537, 537, 0, 0, 0, 0, + 1025, 537, 231, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 1173, 230, 0, 0, 0, 232, 233, + 0, 1583, 949, 949, 0, 0, 0, 0, 234, 0, + 299, 0, 0, 0, 0, 0, 0, 92, 93, 231, + 95, 235, 0, 0, 42, 236, 237, 0, 0, 0, + 0, 0, 1399, 0, 238, 232, 233, 89, 0, 0, + 0, 0, 0, 0, 0, 234, 123, 0, 0, 0, + 0, 0, 0, 0, 92, 93, 299, 95, 235, 0, + 0, 42, 504, 237, 0, 0, 1430, 299, 0, 0, + 1432, 238, 0, 0, -225, -225, 0, -225, -225, 1025, + -225, -225, -225, -225, -225, -225, -225, -225, -225, -225, + -225, -225, -225, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 226, 0, 0, 0, 0, 0, 0, 0, + 227, 228, 0, 1464, 0, 0, 0, 0, 0, 0, + 0, 1583, 0, 0, 0, 0, 0, 1467, 0, 0, + 0, 0, -225, -88, -88, 0, -88, -88, 0, -88, + -88, -88, -88, -88, -88, -88, -88, -88, -88, -88, + -88, -88, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 1025, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 1525, 0, 506, + 226, 0, 0, 0, 0, 397, 123, 0, 227, 228, + 0, -88, 0, 0, 0, 0, 0, 0, 1173, 0, + 1173, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 230, 0, 0, 876, 0, + 877, 878, 879, 880, 0, 881, 0, 882, 883, -225, + -225, -225, -225, 0, 884, 0, 885, 0, 886, 0, + 231, 0, 0, 0, 0, 0, 0, 0, 1240, 1240, + 0, 0, 0, 0, 1564, 1025, 232, 233, 0, 0, + -225, 0, 0, -225, -225, -225, 234, 0, 412, 0, + 0, 0, 0, 0, 1203, 92, 93, 0, 95, 235, + 0, 0, 42, 236, 237, 0, 0, 0, -88, -88, + -88, -88, 238, 230, 0, 0, 0, 0, 0, 1592, + 1593, 1594, 1595, 1596, 1597, 1598, 1599, 1600, 1601, 1602, + 1603, 1604, 1605, 1606, 1610, 1611, 1613, 1615, 231, -88, + -88, 0, -88, -88, -88, 0, -88, 0, 0, 226, + 0, 0, 0, 0, 232, 233, 0, 227, 228, 616, + 0, 0, 0, 0, 234, 0, 0, 0, 0, 0, + 0, 0, 0, 92, 93, 0, 95, 235, 0, 0, + 42, 236, 237, 0, 0, 0, 0, 0, 617, 1649, + 238, 0, 0, 0, 0, 0, 618, 0, 619, 620, + 621, 622, 0, 623, 0, 624, 0, 0, 0, 0, + 0, 0, 0, 0, 1203, 0, 0, 0, 0, 0, + 0, 226, 0, 0, 0, 0, 0, 0, 0, 227, + 228, 1675, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 1676, 1677, + 0, 0, 226, 1678, 0, 1679, 0, 0, 0, 863, + 227, 228, 230, 864, 865, 866, 867, 868, 869, 0, + 0, 0, 0, 0, 0, 870, 871, 872, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 231, 0, 0, + 876, 0, 877, 0, 879, 880, 0, 881, 0, 882, + 883, 0, 0, 232, 233, 89, 884, 1292, 885, 0, + 886, 0, 1701, 234, 0, 1293, 1294, 0, 0, 0, + 0, 0, 92, 93, 0, 95, 235, 0, 0, 625, + 504, 237, 0, 0, 230, 0, 0, 0, 1713, 238, + 1295, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 1720, 597, 1701, 1723, 0, 0, 231, + 0, 598, 1725, 599, 600, 230, 0, 1728, 0, 0, + 0, 0, 0, 0, 0, 232, 233, 0, 0, 0, + 0, 0, 0, 226, 0, 234, 0, 0, 0, 0, + 231, 227, 228, 0, 92, 93, 0, 95, 235, 0, + 0, 42, 236, 237, 0, 1296, 232, 233, 0, 0, + 0, 238, 0, 226, 0, 0, 234, 0, 0, 0, + 230, 227, 228, 0, 0, 92, 93, 0, 95, 235, + 588, 0, 42, 236, 237, 0, 0, 589, 0, 590, + 591, 0, 238, 0, 0, 231, 0, 0, 0, 0, + 0, 1297, 0, 0, 0, 0, 0, 0, 0, 0, + 597, 1298, 1299, 0, 0, 0, 226, 598, 0, 599, + 600, 234, 0, 0, 227, 228, 0, 0, 0, 0, + 1300, 1301, 0, 1302, 1303, 0, 0, 42, 1304, 237, + 0, 0, 0, 0, 0, 226, 230, 238, 0, 0, + 0, 0, 0, 227, 228, 0, 0, 0, -762, 0, + 0, 0, 1148, 1149, 0, 0, 0, 0, 0, 226, + 1150, 231, 1151, 0, 0, 0, 230, 227, 228, 0, + 0, 0, 4, 0, 0, 0, 0, 232, 233, 0, + 0, 0, 0, 0, 0, 0, 0, 234, -762, 0, + 0, 231, 0, 0, 0, 0, 92, 93, 0, 95, + 235, 0, 0, 42, 236, 237, 226, 232, 233, 0, + 0, 0, 8, 238, 227, 228, 921, 234, 0, 230, + 0, 0, 0, 0, 0, 0, 92, 93, 0, 95, + 235, 0, 0, 42, 236, 237, 0, 226, 0, 0, + 0, 0, 0, 238, 231, 227, 228, 0, 230, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 232, 233, 0, 0, 0, 0, 0, 0, 226, 0, + 234, 0, 230, 231, 0, 0, 227, 228, 1246, 92, + 93, 0, 95, 235, 0, 0, 42, 236, 237, 232, + 233, 0, 226, 0, 0, 0, 238, 231, 0, 234, + 227, 228, -392, 0, 0, 0, 0, 0, 92, 93, + 0, 95, 235, 232, 233, 339, 236, 237, 0, 230, + 0, -762, 226, 234, 0, 238, 0, 0, 0, 0, + 227, 228, 92, 93, 0, 95, 235, 0, 0, 42, + 236, 237, 0, 0, 231, 12, 226, 0, 0, 238, + 230, 0, 0, 0, 227, 228, 0, 0, 0, 0, + 232, 233, 0, 0, 0, 0, 0, 0, 0, 0, + 234, 0, 0, 0, 0, 231, 226, 0, 0, 92, + 93, 230, 95, 235, 227, 228, 42, 236, 237, 0, + 0, 232, 233, 0, 0, 0, 238, 0, 0, 0, + 226, 234, 0, 0, 0, 230, 231, 0, 227, 228, + 92, 93, 0, 95, 235, 0, 0, 536, 236, 237, + 1234, 0, 232, 233, 0, 0, 0, 238, 0, 226, + 231, 0, 234, 0, 0, 230, 0, 227, 228, 0, + 0, 92, 93, 0, 95, 235, 232, 233, 42, 236, + 237, 0, 0, 0, 0, 0, 234, 0, 238, 230, + 231, 0, 226, 0, 0, 92, 93, 0, 95, 235, + 227, 228, 42, 236, 237, 0, 232, 233, 0, 0, + 0, 0, 238, 0, 231, 0, 234, 0, 0, 230, + 0, 0, 0, 0, 0, 92, 93, 0, 95, 235, + 232, 233, 42, 236, 353, 0, 0, 226, 0, 0, + 234, 0, 238, 230, 231, 227, 228, 0, 0, 92, + 93, 0, 95, 235, 0, 0, 42, 236, 356, 0, + 232, 233, 0, 0, 0, 0, 238, 0, 231, 0, + 234, 0, 230, 0, 0, 0, 0, 0, 0, 92, + 93, 0, 95, 235, 232, 233, 42, 236, 405, 0, + 0, 0, 0, 0, 234, 0, 238, 231, 0, 0, + 0, 0, 0, 92, 93, 230, 95, 235, 0, 0, + 42, 236, 237, 232, 233, 0, 0, 0, 0, 79, + 238, 0, 0, 234, 0, 0, 80, 0, 0, 0, + 231, 0, 92, 93, 0, 95, 235, 0, 0, 536, + 236, 237, 0, 0, 0, 0, 232, 233, 0, 238, + 230, 0, 0, 0, 0, 0, 234, 0, 0, 0, + 0, 0, 0, 0, 0, 92, 93, 0, 95, 235, + 0, 0, 42, 236, 1024, 231, 81, 0, 0, 0, + 0, 0, 238, 0, 0, 0, 0, 0, 0, 0, + 0, 232, 233, 82, 83, 0, 0, 0, 0, 0, + 0, 234, 0, 0, 0, 84, 0, 0, 0, 0, + 92, 93, 0, 95, 235, 0, 0, 1077, 1078, 1079, + 0, 0, 0, 0, -447, 0, 85, 238, 86, 87, + 0, 0, 0, 0, -460, 0, -473, 0, 80, 0, + 0, 88, 0, 0, 155, 0, 0, 0, 0, 0, + 0, 0, 0, -705, 156, 0, 0, 0, 0, 0, + 0, 89, 0, 0, 90, 91, -332, 0, 0, -332, + -332, -332, -332, 0, 0, 0, 0, -332, 92, 93, + 94, 95, 0, -332, 157, 96, 97, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 158, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + -705, -705, -705, 0, 159, 0, 80, 84, 0, -705, + 0, 160, 155, 0, 161, 162, 0, 163, 0, 0, + 164, 0, 156, 165, 166, 167, 0, -705, 0, 80, + 0, 0, 0, 0, 0, 155, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 156, 0, 0, 0, 168, + 0, 0, 157, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 89, -705, -705, 90, 158, 0, 0, + 0, 0, 0, 0, 0, 157, 0, 0, 0, 0, + 92, 93, 159, 95, 0, 84, -128, 169, 97, 160, + 158, 0, 161, 162, 0, 163, 0, 0, 164, 0, + 0, 165, 166, 167, 0, 159, 0, 0, 84, -129, + 0, 0, 160, 155, 0, 161, 162, 0, 163, 0, + 0, 164, 0, 156, 165, 166, 167, 168, 0, 0, + 0, 0, 0, 0, 0, 0, 818, 0, 0, 0, + 0, 89, 0, 0, 90, 0, 0, 0, 0, 0, + 168, 0, 0, 157, 0, 0, -128, 0, 92, 93, + 0, 95, 0, 818, 89, 169, 97, 90, 158, 0, + 0, 0, 0, 0, 0, 0, 157, 0, 0, -129, + 0, 92, 93, 159, 95, 0, 84, -125, 169, 97, + 160, 158, 0, 161, 162, 0, 163, 0, 0, 164, + 0, 0, 165, 166, 167, 0, 159, 0, 0, 0, + 0, 0, 0, 160, 0, 0, 161, 162, 0, 163, + 0, 0, 164, 0, 0, 165, 166, 167, 168, 0, + 0, 0, 0, 159, 0, 0, 0, 0, -197, 0, + 0, 0, 89, 161, 162, 90, 163, 0, 0, 164, + 0, 168, 819, 166, 820, 0, 0, -125, 0, 92, + 93, 0, 95, 0, 0, 89, 169, 97, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 92, 93, 0, 95, 0, 0, 0, 42, + 97, 0, 89, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 92, + 93, 0, 95, 0, 0, 0, 42, 97 +}; + +#define yypact_value_is_default(Yystate) \ + (!!((Yystate) == (-1407))) + +#define yytable_value_is_error(Yytable_value) \ + YYID (0) + +static const yytype_int16 yycheck[] = +{ + 11, 52, 213, 168, 459, 220, 294, 52, 459, 497, + 90, 56, 384, 294, 384, 291, 168, 154, 237, 52, + 288, 294, 653, 918, 57, 219, 494, 720, 136, 62, + 63, 109, 154, 855, 590, 322, 73, 605, 52, 258, + 141, 52, 52, 599, 550, 1003, 57, 1003, 213, 100, + 319, 62, 63, 931, 979, 100, 294, 164, 165, 52, + 672, 94, 73, 694, 258, 259, 569, 100, 624, 932, + 933, 104, 497, 305, 932, 933, 879, 880, 864, 865, + 866, 1024, 1094, 94, 1270, 871, 100, 1172, 1274, 100, + 100, 1277, 495, 104, 110, 3, 1502, 939, 3, 1262, + 172, 24, 1265, 3, 3, 56, 18, 100, 5, 4, + 22, 21, 3, 27, 3, 3, 237, 937, 3, 3, + 24, 21, 237, 1453, 3, 24, 47, 167, 48, 3, + 3, 730, 3, 24, 353, 24, 24, 356, 737, 172, + 24, 64, 3, 258, 97, 24, 3, 5, 3, 5, + 382, 325, 192, 305, 109, 3, 3, 24, 3, 5, + 64, 172, 3, 24, 3, 64, 1024, 24, 3, 3, + 3, 459, 259, 64, 3, 64, 64, 24, 459, 24, + 64, 3, 184, 220, 399, 64, 405, 559, 1083, 3, + 3, 111, 145, 5, 3, 3, 333, 3, 3, 3, + 374, 3, 21, 64, 3, 420, 3, 64, 159, 3, + 131, 333, 3, 3, 3, 3, 1159, 64, 24, 64, + 24, 3, 24, 3, 418, 24, 237, 3, 380, 381, + 382, 425, 353, 311, 428, 356, 191, 431, 353, 317, + 24, 356, 3, 1573, 21, 521, 353, 19, 20, 356, + 170, 1414, 677, 325, 154, 24, 1076, 712, 64, 154, + 64, 22, 64, 191, 21, 64, 3, 304, 279, 154, + 24, 136, 3, 310, 197, 968, 1682, 191, 497, 191, + 191, 191, 319, 294, 405, 322, 194, 388, 146, 194, + 405, 199, 325, 197, 1379, 64, 193, 418, 197, 315, + 316, 1159, 374, 497, 585, 194, 197, 160, 197, 197, + 64, 200, 585, 197, 325, 1258, 872, 1120, 197, 722, + 194, 194, 878, 194, 605, 881, 1112, 1169, 193, 885, + 197, 418, 605, 384, 146, 500, 197, 193, 331, 194, + 197, 374, 353, 846, 431, 356, 194, 193, 359, 193, + 197, 384, 197, 194, 305, 194, 968, 194, 174, 194, + 194, 194, 399, 374, 24, 194, 194, 113, 1414, 29, + 191, 31, 194, 384, 193, 1006, 497, 193, 3, 3, + 194, 194, 497, 420, 421, 194, 194, 619, 1551, 194, + 1553, 197, 160, 197, 405, 197, 1559, 194, 197, 1585, + 194, 394, 395, 194, 194, 194, 194, 1570, 184, 185, + 421, 187, 194, 111, 194, 191, 193, 154, 498, 499, + 192, 167, 191, 154, 19, 20, 459, 87, 197, 380, + 381, 382, 720, 384, 24, 24, 193, 191, 3, 720, + 518, 717, 3, 197, 124, 97, 192, 720, 459, 191, + 665, 662, 560, 18, 114, 666, 667, 22, 677, 191, + 193, 22, 495, 496, 497, 197, 1344, 619, 52, 688, + 571, 1396, 170, 610, 64, 64, 556, 169, 24, 586, + 587, 588, 720, 677, 495, 496, 497, 763, 610, 500, + 597, 1434, 1504, 145, 688, 175, 1454, 662, 1454, 191, + 24, 666, 667, 143, 1367, 97, 1552, 1553, 559, 1367, + 786, 191, 172, 1559, 559, 1003, 100, 550, 64, 1007, + 531, 566, 182, 991, 979, 1571, 559, 1330, 979, 154, + 154, 154, 172, 52, 19, 20, 805, 197, 807, 550, + 64, 29, 553, 31, 1347, 559, 740, 24, 559, 559, + 24, 1182, 566, 145, 116, 117, 677, 590, 591, 22, + 24, 97, 677, 24, 1070, 146, 599, 600, 191, 52, + 1138, 18, 1358, 688, 585, 22, 1434, 52, 1003, 590, + 591, 100, 1007, 19, 20, 4, 154, 64, 599, 600, + 64, 624, 193, 188, 605, 1151, 191, 192, 52, 191, + 64, 191, 191, 64, 1499, 638, 102, 197, 197, 145, + 154, 107, 193, 624, 110, 566, 1574, 100, 1574, 740, + 29, 193, 31, 191, 154, 100, 637, 638, 665, 191, + 172, 12, 13, 14, 15, 16, 17, 18, 589, 124, + 38, 1463, 653, 139, 1551, 191, 100, 598, 99, 100, + 101, 197, 29, 140, 31, 191, 28, 29, 30, 31, + 167, 191, 33, 1570, 149, 37, 677, 191, 619, 24, + 621, 622, 623, 197, 29, 182, 31, 48, 87, 130, + 165, 166, 188, 694, 130, 192, 192, 138, 124, 722, + 175, 979, 191, 980, 193, 191, 168, 169, 979, 184, + 185, 712, 187, 188, 142, 114, 191, 192, 193, 720, + 87, 722, 819, 5, 191, 87, 201, 191, 191, 191, + 197, 194, 800, 197, 1552, 762, 193, 191, 184, 185, + 191, 187, 840, 197, 112, 191, 197, 114, 194, 175, + 174, 1434, 114, 1571, 1639, 1213, 4, 848, 184, 185, + 24, 187, 188, 193, 765, 191, 192, 1212, 193, 193, + 194, 193, 869, 172, 199, 199, 124, 804, 805, 167, + 807, 193, 104, 182, 106, 882, 913, 199, 930, 193, + 161, 162, 163, 164, 1003, 193, 184, 185, 1007, 187, + 64, 913, 899, 191, 192, 172, 747, 1428, 905, 1171, + 172, 1171, 193, 191, 855, 1024, 194, 191, 1262, 112, + 194, 1265, 919, 1007, 195, 196, 200, 175, 167, 193, + 1101, 1262, 855, 47, 1265, 197, 184, 185, 1101, 187, + 867, 191, 193, 191, 194, 184, 185, 193, 187, 872, + 200, 193, 191, 192, 855, 878, 879, 880, 881, 1188, + 883, 1190, 885, 886, 1019, 192, 425, 1138, 1309, 428, + 1079, 872, 1313, 192, 193, 1138, 200, 878, 879, 880, + 881, 5, 883, 918, 885, 886, 29, 29, 31, 31, + 21, 22, 1003, 920, 200, 918, 1007, 174, 1003, 157, + 158, 159, 1007, 167, 175, 176, 177, 178, 909, 932, + 933, 23, 183, 1024, 855, 6, 7, 918, 189, 1024, + 184, 185, 10, 187, 99, 100, 9, 191, 192, 870, + 193, 932, 933, 197, 175, 176, 177, 178, 172, 173, + 191, 192, 183, 884, 87, 87, 172, 173, 189, 193, + 191, 1396, 191, 980, 191, 1396, 979, 104, 105, 1217, + 40, 41, 191, 184, 185, 4, 187, 968, 1079, 191, + 191, 114, 114, 194, 1079, 1002, 1454, 918, 979, 5, + 184, 185, 1079, 187, 1007, 1588, 1589, 191, 191, 930, + 194, 146, 65, 66, 62, 63, 25, 1263, 208, 209, + 199, 1002, 1003, 1073, 168, 1006, 1007, 80, 326, 327, + 104, 84, 1221, 1375, 193, 1375, 193, 90, 1019, 1220, + 1117, 184, 185, 1024, 187, 191, 19, 20, 191, 172, + 172, 107, 194, 5, 110, 1132, 194, 1221, 1309, 182, + 182, 5, 1313, 5, 120, 150, 122, 1070, 1083, 125, + 126, 3, 1149, 174, 174, 1056, 174, 68, 69, 70, + 1083, 72, 194, 139, 202, 1220, 174, 194, 144, 1070, + 99, 100, 101, 5, 184, 185, 1103, 187, 1079, 193, + 1081, 191, 1083, 193, 191, 158, 184, 185, 22, 187, + 191, 1275, 191, 191, 3, 168, 1574, 1120, 193, 3, + 1101, 130, 194, 132, 133, 134, 110, 194, 137, 138, + 1221, 140, 141, 4, 184, 185, 1221, 187, 1396, 1120, + 173, 191, 191, 193, 1147, 1396, 154, 3, 1151, 3, + 1171, 124, 191, 193, 199, 4, 194, 1138, 4, 4, + 113, 193, 134, 191, 182, 11, 1147, 194, 1171, 194, + 1151, 102, 193, 19, 20, 21, 107, 182, 194, 110, + 5, 191, 39, 182, 191, 182, 3, 174, 18, 120, + 1171, 122, 165, 166, 125, 126, 194, 5, 3, 193, + 1181, 1182, 175, 22, 193, 3, 191, 1214, 139, 21, + 193, 184, 185, 144, 187, 188, 193, 21, 191, 192, + 193, 103, 275, 193, 193, 3, 193, 280, 193, 1150, + 283, 1212, 3, 3, 191, 191, 146, 290, 193, 169, + 1221, 139, 193, 154, 3, 114, 3, 193, 3, 5, + 1171, 304, 5, 30, 307, 1262, 5, 194, 1265, 3, + 191, 194, 31, 1270, 29, 1690, 194, 1274, 194, 194, + 1277, 194, 3, 3, 194, 4, 102, 5, 124, 1286, + 193, 107, 1703, 21, 110, 1362, 1267, 193, 191, 4, + 343, 344, 4, 346, 120, 20, 122, 194, 191, 125, + 126, 191, 355, 149, 357, 5, 1309, 194, 154, 194, + 1313, 194, 3, 139, 194, 368, 3, 370, 144, 165, + 166, 194, 4, 26, 194, 1246, 94, 1330, 1309, 175, + 73, 1338, 1313, 5, 194, 5, 199, 390, 184, 185, + 4, 187, 188, 3, 1347, 191, 192, 193, 199, 1330, + 193, 103, 191, 194, 1375, 201, 194, 193, 191, 194, + 1545, 103, 4, 1544, 1367, 146, 1347, 3, 5, 3, + 5, 4, 1375, 3, 5, 193, 5, 3, 22, 194, + 1561, 3, 21, 4, 3, 3, 1367, 1394, 3, 21, + 4, 3, 194, 1396, 1375, 3, 193, 4, 194, 194, + 194, 194, 194, 191, 191, 191, 3, 1414, 191, 1544, + 194, 3, 191, 4, 467, 1396, 4, 22, 471, 5, + 194, 3, 194, 4, 3, 3, 1561, 194, 194, 482, + 194, 193, 3, 194, 194, 4, 1357, 4, 3, 49, + 94, 4, 1463, 194, 194, 498, 499, 1428, 1586, 502, + 104, 1454, 1703, 1434, 1375, 508, 1003, 100, 1714, 913, + 1463, 20, 1003, 412, 1266, 1275, 518, 717, 1263, 1218, + 1267, 1265, 525, 11, 421, 1003, 1428, 1427, 405, 252, + 786, 534, 1463, 1046, 1499, 1553, 1414, 1554, 788, 1559, + 543, 720, 4, 496, 1007, 1003, 1499, 977, 551, 11, + 1056, 1212, 1283, 556, 800, 1512, 1509, 19, 20, 21, + 1690, 1692, 460, 1560, 886, 990, 553, 1520, 1499, 1510, + 1019, 1520, 575, 559, 1101, 1347, 1338, 1512, 1509, 559, + 447, 1521, 448, 266, 452, 450, 455, 762, 1545, 1520, + 805, 807, 1463, 802, 1551, 1552, 1553, 564, 559, 564, + 1117, 327, 1559, 1377, 386, 318, 618, 1692, 559, 559, + 876, 73, 1362, 1570, 1571, 600, 559, 559, 381, 559, + 930, 1574, 1434, 620, 933, 899, 905, 559, 1585, 52, + 559, 559, 94, 636, 57, 333, 1132, 54, 1682, 62, + 63, 281, 4, 468, 647, 710, 559, 694, 1182, 11, + 1181, 26, 1390, 656, -1, 1586, 637, 19, 20, 21, + 1185, 657, 124, 1081, -1, -1, -1, -1, 0, 1, + -1, 94, -1, -1, 1639, -1, -1, 100, -1, -1, + -1, 104, -1, -1, -1, -1, 1639, 149, -1, -1, + -1, 1648, 24, -1, -1, -1, 28, 29, 30, 31, + -1, -1, -1, 165, 166, 37, 1663, -1, 1639, -1, + -1, -1, -1, 175, 318, -1, -1, -1, 721, -1, + -1, -1, 184, 185, -1, 187, 188, -1, 4, 191, + 192, 193, 64, -1, -1, 11, -1, -1, -1, 201, + 743, -1, 745, 19, 20, -1, -1, -1, -1, 172, + 1703, 1708, -1, -1, 1711, 87, -1, 760, -1, 1690, + -1, -1, 124, 766, -1, -1, -1, 1724, 1639, 1640, + -1, -1, 1703, -1, -1, -1, 380, 381, -1, -1, + -1, -1, 114, -1, -1, -1, -1, 149, -1, -1, + -1, -1, -1, -1, 4, 798, -1, -1, -1, -1, + -1, 11, -1, 165, 166, -1, -1, 810, -1, 19, + 20, -1, 815, 175, 817, -1, -1, -1, -1, -1, + -1, -1, 184, 185, -1, 187, 188, -1, -1, 191, + 192, 193, -1, -1, -1, -1, -1, -1, -1, 201, + 172, 844, -1, 175, 176, 177, 178, -1, 124, -1, + -1, 183, 855, -1, -1, -1, -1, 189, -1, -1, + -1, -1, -1, -1, -1, 197, -1, 5, 6, 7, + 8, 9, 10, 149, 12, 13, 14, 15, 16, 17, + -1, 19, 20, 21, 22, 23, -1, -1, -1, 165, + 166, 495, 496, -1, -1, 318, -1, 900, -1, 175, + -1, -1, 325, 906, -1, -1, -1, -1, 184, 185, + -1, 187, 188, -1, 124, 191, 192, 193, -1, -1, + -1, -1, -1, -1, -1, 201, -1, -1, -1, -1, + -1, -1, -1, 4, -1, -1, -1, -1, 941, 149, + 11, 944, 945, -1, -1, -1, 550, -1, 19, 20, + -1, 374, 38, -1, -1, 165, 166, 380, 381, -1, + -1, 384, -1, -1, -1, 175, -1, -1, -1, -1, + -1, -1, -1, -1, 184, 185, -1, 187, 188, -1, + -1, 191, 192, 193, -1, -1, 590, 591, -1, -1, + -1, 201, 78, -1, -1, 599, 600, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 93, 157, -1, + -1, -1, -1, -1, 618, -1, -1, 103, -1, 168, + 624, -1, 108, 1026, -1, -1, 1029, -1, -1, 115, + -1, -1, 118, 119, 638, 121, -1, 1040, 124, 1042, + -1, 127, 128, 129, 1047, -1, -1, -1, -1, 653, + -1, 1054, 1055, 124, -1, -1, 194, 195, 196, -1, + -1, -1, -1, -1, -1, -1, -1, 153, -1, -1, + 1073, 1074, 495, 496, 497, -1, -1, -1, 149, -1, + -1, 167, 231, 124, 1087, -1, 1089, -1, 237, -1, + 694, -1, -1, -1, 165, 166, -1, 1100, 184, 185, + -1, 187, -1, 252, 175, 191, 192, -1, 149, -1, + -1, -1, -1, 184, 185, -1, 187, 188, 722, -1, + 191, 192, 193, -1, 165, 166, -1, 550, -1, -1, + 201, -1, -1, -1, 175, -1, 559, -1, -1, -1, + -1, -1, -1, 184, 185, -1, 187, 188, -1, -1, + 191, 192, 193, -1, 1157, -1, 305, 306, 1161, -1, + 201, -1, 1165, -1, 1167, 1168, -1, 590, 591, 318, + -1, -1, 321, -1, -1, 1178, 599, 600, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 337, 338, + -1, -1, -1, -1, -1, 618, -1, -1, -1, -1, + -1, 624, -1, 1206, 353, -1, -1, 356, -1, -1, + 1213, 4, -1, 1216, -1, 638, 1219, -1, 11, -1, + -1, -1, -1, -1, -1, -1, 19, 20, -1, 378, + 653, 380, 381, 382, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 405, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 872, -1, + -1, 694, -1, -1, 878, 879, 880, 881, -1, 883, + -1, 885, 886, -1, 1287, -1, 1289, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 722, + -1, -1, -1, 4, -1, -1, -1, -1, -1, -1, + 11, -1, -1, -1, -1, -1, -1, 1320, 19, 20, + -1, -1, -1, 1326, -1, -1, 930, -1, 932, 933, + -1, 124, -1, -1, -1, -1, -1, -1, -1, 1342, + -1, -1, -1, 1346, -1, -1, -1, -1, -1, -1, + -1, 500, -1, -1, -1, -1, 149, -1, -1, -1, + 1363, -1, 1365, 512, -1, 1368, -1, 1370, 1371, -1, + 1373, -1, 165, 166, -1, -1, -1, -1, -1, -1, + -1, 1384, 175, -1, -1, -1, -1, -1, -1, -1, + -1, 184, 185, -1, 187, 188, -1, -1, 191, 192, + 193, -1, 1006, -1, -1, -1, -1, -1, 201, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 1024, -1, -1, 124, -1, -1, -1, -1, -1, -1, + -1, 4, 855, 1436, -1, -1, -1, -1, 11, -1, + -1, -1, -1, -1, -1, -1, 19, 20, 149, 872, + -1, -1, -1, -1, -1, 878, 879, 880, 881, -1, + 883, -1, 885, 886, 165, 166, 1070, -1, -1, -1, + 619, -1, -1, -1, 175, -1, -1, -1, 4, -1, + -1, -1, -1, 184, 185, 11, 187, 188, -1, -1, + 191, 192, 193, 19, 20, 918, -1, 1500, -1, -1, + 201, -1, -1, 1506, 653, -1, -1, 930, 1511, 932, + 933, -1, -1, -1, -1, -1, 1120, -1, -1, 1522, + 1523, 1524, -1, 672, -1, -1, -1, -1, -1, -1, + 1533, -1, -1, -1, -1, -1, -1, -1, 1541, -1, + 1543, -1, -1, 1147, -1, 694, -1, 1151, -1, -1, + 4, 124, -1, -1, -1, 1159, 705, 11, 707, -1, + -1, -1, -1, -1, -1, 19, 20, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 149, 1181, 1182, -1, + 1003, -1, -1, 1006, 1007, -1, -1, -1, -1, -1, + -1, -1, 165, 166, -1, -1, -1, 746, 124, 748, + -1, 1024, 175, -1, -1, -1, -1, 756, -1, -1, + 759, 184, 185, 1616, 187, 188, -1, -1, 191, 192, + 193, -1, -1, 149, -1, -1, -1, -1, 201, -1, + 1633, -1, -1, -1, -1, -1, -1, -1, -1, 165, + 166, 1644, -1, -1, -1, -1, -1, 1070, -1, 175, + -1, -1, -1, -1, -1, -1, -1, -1, 184, 185, + 1083, 187, 188, -1, -1, 191, 192, 193, 5, -1, + 124, -1, -1, -1, 11, 201, -1, -1, 1681, -1, + -1, 1684, 19, 20, -1, 22, -1, -1, -1, -1, + -1, -1, -1, -1, 843, 149, -1, 1120, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 165, 166, -1, 863, 864, 865, 866, -1, -1, + -1, 175, 871, -1, 1147, -1, 1330, 876, 1151, -1, + 184, 185, -1, 187, 188, -1, 1159, 191, 192, 193, + -1, -1, -1, 1347, -1, -1, -1, 201, 1171, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 1181, 1182, + -1, -1, 911, 1367, -1, -1, -1, -1, -1, -1, + -1, 5, -1, -1, -1, -1, -1, 11, -1, -1, + -1, 930, 931, -1, -1, 19, 20, 124, 937, -1, + -1, 940, -1, -1, -1, 5, -1, -1, -1, -1, + -1, 11, -1, -1, -1, -1, -1, -1, -1, 19, + 20, -1, 149, -1, -1, -1, -1, -1, -1, 968, + -1, -1, -1, 1427, 1428, -1, -1, 976, 165, 166, + 1434, -1, -1, -1, -1, -1, -1, -1, 175, -1, + -1, -1, -1, -1, -1, -1, -1, 184, 185, -1, + 187, 188, -1, -1, 191, 192, 193, 1006, -1, -1, + -1, -1, -1, -1, 201, 1014, -1, -1, 5, 1018, + 1019, -1, 1021, 1022, 11, 1024, -1, -1, -1, -1, + -1, -1, 19, 20, -1, -1, -1, -1, -1, -1, + 124, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 1509, -1, 1330, -1, -1, + -1, 11, -1, -1, 124, 149, 1520, -1, -1, 19, + 20, 21, -1, -1, 1347, -1, -1, 1076, -1, -1, + 1079, 165, 166, 1082, -1, -1, -1, -1, -1, 149, + -1, 175, -1, -1, 1367, -1, -1, -1, -1, -1, + 184, 185, 1375, 187, 188, 165, 166, 191, 192, 193, + -1, -1, -1, 1112, -1, 175, -1, 201, -1, -1, + -1, -1, -1, -1, 184, 185, -1, 187, 188, -1, + -1, 191, 192, 193, -1, -1, -1, 124, -1, -1, + -1, 201, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 1427, 1428, -1, -1, -1, -1, + 1159, 1434, 149, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 1172, 124, -1, -1, -1, 165, 166, + -1, 1454, 1181, 1182, -1, -1, -1, -1, 175, -1, + 1463, -1, -1, -1, -1, -1, -1, 184, 185, 149, + 187, 188, -1, -1, 191, 192, 193, -1, -1, -1, + -1, -1, 1211, -1, 201, 165, 166, 167, -1, -1, + -1, -1, -1, -1, -1, 175, 1499, -1, -1, -1, + -1, -1, -1, -1, 184, 185, 1509, 187, 188, -1, + -1, 191, 192, 193, -1, -1, 1245, 1520, -1, -1, + 1249, 201, -1, -1, 6, 7, -1, 9, 10, 1258, + 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, + 22, 23, 24, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 11, -1, -1, -1, -1, -1, -1, -1, + 19, 20, -1, 1292, -1, -1, -1, -1, -1, -1, + -1, 1574, -1, -1, -1, -1, -1, 1306, -1, -1, + -1, -1, 64, 6, 7, -1, 9, 10, -1, 12, + 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, + 23, 24, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 1344, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 1356, -1, 1358, + 11, -1, -1, -1, -1, 94, 1639, -1, 19, 20, + -1, 64, -1, -1, -1, -1, -1, -1, 1377, -1, + 1379, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 124, -1, -1, 49, -1, + 51, 52, 53, 54, -1, 56, -1, 58, 59, 161, + 162, 163, 164, -1, 65, -1, 67, -1, 69, -1, + 149, -1, -1, -1, -1, -1, -1, -1, 1427, 1428, + -1, -1, -1, -1, 1433, 1434, 165, 166, -1, -1, + 192, -1, -1, 195, 196, 197, 175, -1, 200, -1, + -1, -1, -1, -1, 1453, 184, 185, -1, 187, 188, + -1, -1, 191, 192, 193, -1, -1, -1, 161, 162, + 163, 164, 201, 124, -1, -1, -1, -1, -1, 1478, + 1479, 1480, 1481, 1482, 1483, 1484, 1485, 1486, 1487, 1488, + 1489, 1490, 1491, 1492, 1493, 1494, 1495, 1496, 149, 192, + 193, -1, 195, 196, 197, -1, 199, -1, -1, 11, + -1, -1, -1, -1, 165, 166, -1, 19, 20, 21, + -1, -1, -1, -1, 175, -1, -1, -1, -1, -1, + -1, -1, -1, 184, 185, -1, 187, 188, -1, -1, + 191, 192, 193, -1, -1, -1, -1, -1, 50, 1548, + 201, -1, -1, -1, -1, -1, 58, -1, 60, 61, + 62, 63, -1, 65, -1, 67, -1, -1, -1, -1, + -1, -1, -1, -1, 1573, -1, -1, -1, -1, -1, + -1, 11, -1, -1, -1, -1, -1, -1, -1, 19, + 20, 1590, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 1607, 1608, + -1, -1, 11, 1612, -1, 1614, -1, -1, -1, 49, + 19, 20, 124, 53, 54, 55, 56, 57, 58, -1, + -1, -1, -1, -1, -1, 65, 66, 67, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 149, -1, -1, + 49, -1, 51, -1, 53, 54, -1, 56, -1, 58, + 59, -1, -1, 165, 166, 167, 65, 11, 67, -1, + 69, -1, 1671, 175, -1, 19, 20, -1, -1, -1, + -1, -1, 184, 185, -1, 187, 188, -1, -1, 191, + 192, 193, -1, -1, 124, -1, -1, -1, 1697, 201, + 44, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 1712, 58, 1714, 1715, -1, -1, 149, + -1, 65, 1721, 67, 68, 124, -1, 1726, -1, -1, + -1, -1, -1, -1, -1, 165, 166, -1, -1, -1, + -1, -1, -1, 11, -1, 175, -1, -1, -1, -1, + 149, 19, 20, -1, 184, 185, -1, 187, 188, -1, + -1, 191, 192, 193, -1, 109, 165, 166, -1, -1, + -1, 201, -1, 11, -1, -1, 175, -1, -1, -1, + 124, 19, 20, -1, -1, 184, 185, -1, 187, 188, + 58, -1, 191, 192, 193, -1, -1, 65, -1, 67, + 68, -1, 201, -1, -1, 149, -1, -1, -1, -1, + -1, 155, -1, -1, -1, -1, -1, -1, -1, -1, + 58, 165, 166, -1, -1, -1, 11, 65, -1, 67, + 68, 175, -1, -1, 19, 20, -1, -1, -1, -1, + 184, 185, -1, 187, 188, -1, -1, 191, 192, 193, + -1, -1, -1, -1, -1, 11, 124, 201, -1, -1, + -1, -1, -1, 19, 20, -1, -1, -1, 24, -1, + -1, -1, 57, 58, -1, -1, -1, -1, -1, 11, + 65, 149, 67, -1, -1, -1, 124, 19, 20, -1, + -1, -1, 24, -1, -1, -1, -1, 165, 166, -1, + -1, -1, -1, -1, -1, -1, -1, 175, 64, -1, + -1, 149, -1, -1, -1, -1, 184, 185, -1, 187, + 188, -1, -1, 191, 192, 193, 11, 165, 166, -1, + -1, -1, 64, 201, 19, 20, 21, 175, -1, 124, + -1, -1, -1, -1, -1, -1, 184, 185, -1, 187, + 188, -1, -1, 191, 192, 193, -1, 11, -1, -1, + -1, -1, -1, 201, 149, 19, 20, -1, 124, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 165, 166, -1, -1, -1, -1, -1, -1, 11, -1, + 175, -1, 124, 149, -1, -1, 19, 20, 21, 184, + 185, -1, 187, 188, -1, -1, 191, 192, 193, 165, + 166, -1, 11, -1, -1, -1, 201, 149, -1, 175, + 19, 20, 21, -1, -1, -1, -1, -1, 184, 185, + -1, 187, 188, 165, 166, 191, 192, 193, -1, 124, + -1, 197, 11, 175, -1, 201, -1, -1, -1, -1, + 19, 20, 184, 185, -1, 187, 188, -1, -1, 191, + 192, 193, -1, -1, 149, 197, 11, -1, -1, 201, + 124, -1, -1, -1, 19, 20, -1, -1, -1, -1, + 165, 166, -1, -1, -1, -1, -1, -1, -1, -1, + 175, -1, -1, -1, -1, 149, 11, -1, -1, 184, + 185, 124, 187, 188, 19, 20, 191, 192, 193, -1, + -1, 165, 166, -1, -1, -1, 201, -1, -1, -1, + 11, 175, -1, -1, -1, 124, 149, -1, 19, 20, + 184, 185, -1, 187, 188, -1, -1, 191, 192, 193, + 194, -1, 165, 166, -1, -1, -1, 201, -1, 11, + 149, -1, 175, -1, -1, 124, -1, 19, 20, -1, + -1, 184, 185, -1, 187, 188, 165, 166, 191, 192, + 193, -1, -1, -1, -1, -1, 175, -1, 201, 124, + 149, -1, 11, -1, -1, 184, 185, -1, 187, 188, + 19, 20, 191, 192, 193, -1, 165, 166, -1, -1, + -1, -1, 201, -1, 149, -1, 175, -1, -1, 124, + -1, -1, -1, -1, -1, 184, 185, -1, 187, 188, + 165, 166, 191, 192, 193, -1, -1, 11, -1, -1, + 175, -1, 201, 124, 149, 19, 20, -1, -1, 184, + 185, -1, 187, 188, -1, -1, 191, 192, 193, -1, + 165, 166, -1, -1, -1, -1, 201, -1, 149, -1, + 175, -1, 124, -1, -1, -1, -1, -1, -1, 184, + 185, -1, 187, 188, 165, 166, 191, 192, 193, -1, + -1, -1, -1, -1, 175, -1, 201, 149, -1, -1, + -1, -1, -1, 184, 185, 124, 187, 188, -1, -1, + 191, 192, 193, 165, 166, -1, -1, -1, -1, 25, + 201, -1, -1, 175, -1, -1, 32, -1, -1, -1, + 149, -1, 184, 185, -1, 187, 188, -1, -1, 191, + 192, 193, -1, -1, -1, -1, 165, 166, -1, 201, + 124, -1, -1, -1, -1, -1, 175, -1, -1, -1, + -1, -1, -1, -1, -1, 184, 185, -1, 187, 188, + -1, -1, 191, 192, 193, 149, 82, -1, -1, -1, + -1, -1, 201, -1, -1, -1, -1, -1, -1, -1, + -1, 165, 166, 99, 100, -1, -1, -1, -1, -1, + -1, 175, -1, -1, -1, 111, -1, -1, -1, -1, + 184, 185, -1, 187, 188, -1, -1, 191, 192, 193, + -1, -1, -1, -1, 130, -1, 132, 201, 134, 135, + -1, -1, -1, -1, 140, -1, 142, -1, 32, -1, + -1, 147, -1, -1, 38, -1, -1, -1, -1, -1, + -1, -1, -1, 47, 48, -1, -1, -1, -1, -1, + -1, 167, -1, -1, 170, 171, 172, -1, -1, 175, + 176, 177, 178, -1, -1, -1, -1, 183, 184, 185, + 186, 187, -1, 189, 78, 191, 192, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 93, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 104, 105, 106, -1, 108, -1, 32, 111, -1, 113, + -1, 115, 38, -1, 118, 119, -1, 121, -1, -1, + 124, -1, 48, 127, 128, 129, -1, 131, -1, 32, + -1, -1, -1, -1, -1, 38, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 48, -1, -1, -1, 153, + -1, -1, 78, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 167, 168, 169, 170, 93, -1, -1, + -1, -1, -1, -1, -1, 78, -1, -1, -1, -1, + 184, 185, 108, 187, -1, 111, 112, 191, 192, 115, + 93, -1, 118, 119, -1, 121, -1, -1, 124, -1, + -1, 127, 128, 129, -1, 108, -1, -1, 111, 112, + -1, -1, 115, 38, -1, 118, 119, -1, 121, -1, + -1, 124, -1, 48, 127, 128, 129, 153, -1, -1, + -1, -1, -1, -1, -1, -1, 38, -1, -1, -1, + -1, 167, -1, -1, 170, -1, -1, -1, -1, -1, + 153, -1, -1, 78, -1, -1, 182, -1, 184, 185, + -1, 187, -1, 38, 167, 191, 192, 170, 93, -1, + -1, -1, -1, -1, -1, -1, 78, -1, -1, 182, + -1, 184, 185, 108, 187, -1, 111, 112, 191, 192, + 115, 93, -1, 118, 119, -1, 121, -1, -1, 124, + -1, -1, 127, 128, 129, -1, 108, -1, -1, -1, + -1, -1, -1, 115, -1, -1, 118, 119, -1, 121, + -1, -1, 124, -1, -1, 127, 128, 129, 153, -1, + -1, -1, -1, 108, -1, -1, -1, -1, 113, -1, + -1, -1, 167, 118, 119, 170, 121, -1, -1, 124, + -1, 153, 127, 128, 129, -1, -1, 182, -1, 184, + 185, -1, 187, -1, -1, 167, 191, 192, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 184, 185, -1, 187, -1, -1, -1, 191, + 192, -1, 167, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 184, + 185, -1, 187, -1, -1, -1, 191, 192 +}; + +/* YYSTOS[STATE-NUM] -- The (internal number of the) accessing + symbol of state STATE-NUM. */ +static const yytype_uint16 yystos[] = +{ + 0, 204, 0, 1, 24, 28, 30, 37, 64, 87, + 114, 172, 197, 205, 206, 207, 208, 210, 211, 264, + 265, 637, 640, 657, 659, 693, 694, 695, 696, 697, + 707, 708, 184, 212, 191, 191, 175, 176, 177, 178, + 183, 189, 191, 231, 266, 314, 209, 24, 197, 24, + 266, 236, 237, 405, 650, 652, 658, 658, 29, 31, + 114, 695, 658, 658, 209, 660, 641, 268, 267, 272, + 269, 271, 270, 193, 194, 194, 209, 197, 208, 25, + 32, 82, 99, 100, 111, 132, 134, 135, 147, 167, + 170, 171, 184, 185, 186, 187, 191, 192, 231, 238, + 239, 240, 251, 259, 260, 288, 290, 292, 330, 331, + 346, 364, 369, 386, 387, 392, 397, 398, 405, 406, + 412, 416, 422, 433, 435, 444, 446, 448, 451, 452, + 453, 514, 515, 540, 541, 542, 544, 550, 551, 554, + 560, 565, 588, 611, 636, 674, 677, 719, 160, 652, + 259, 260, 639, 646, 720, 38, 48, 78, 93, 108, + 115, 118, 119, 121, 124, 127, 128, 129, 153, 191, + 241, 242, 252, 253, 259, 458, 475, 514, 515, 525, + 526, 530, 540, 559, 560, 569, 570, 573, 585, 586, + 587, 588, 589, 594, 601, 605, 608, 611, 624, 627, + 630, 682, 687, 719, 191, 710, 191, 700, 241, 241, + 206, 206, 21, 193, 273, 274, 273, 273, 273, 21, + 193, 284, 285, 286, 273, 4, 11, 19, 20, 21, + 124, 149, 165, 166, 175, 188, 192, 193, 201, 231, + 254, 257, 263, 275, 276, 279, 280, 288, 289, 315, + 316, 321, 323, 433, 482, 483, 484, 485, 486, 489, + 490, 492, 494, 495, 496, 497, 498, 502, 505, 507, + 680, 689, 393, 206, 193, 417, 418, 3, 206, 213, + 545, 154, 191, 675, 676, 154, 400, 22, 423, 206, + 545, 3, 293, 294, 193, 373, 374, 376, 377, 433, + 435, 4, 193, 240, 102, 107, 110, 139, 191, 435, + 193, 291, 264, 366, 400, 130, 140, 142, 146, 193, + 516, 5, 193, 447, 538, 539, 547, 547, 538, 651, + 112, 638, 647, 648, 649, 696, 707, 193, 193, 191, + 231, 235, 502, 558, 191, 206, 260, 191, 197, 722, + 193, 193, 633, 193, 507, 592, 193, 592, 193, 193, + 206, 502, 504, 505, 510, 511, 512, 513, 590, 4, + 112, 246, 247, 243, 244, 245, 252, 636, 110, 120, + 122, 125, 126, 144, 527, 47, 571, 572, 576, 193, + 683, 193, 714, 193, 246, 246, 192, 94, 512, 193, + 276, 287, 73, 94, 263, 193, 322, 325, 326, 327, + 502, 200, 200, 231, 275, 278, 279, 281, 489, 502, + 5, 3, 194, 322, 23, 487, 21, 22, 488, 275, + 276, 489, 276, 485, 12, 13, 14, 15, 16, 17, + 18, 161, 162, 163, 164, 195, 196, 491, 493, 10, + 499, 9, 500, 6, 7, 501, 492, 193, 193, 419, + 3, 206, 116, 117, 231, 546, 206, 675, 3, 206, + 191, 678, 679, 191, 18, 22, 425, 426, 206, 295, + 296, 346, 191, 154, 191, 377, 378, 379, 446, 450, + 451, 452, 3, 371, 372, 427, 3, 22, 111, 170, + 449, 206, 507, 21, 192, 260, 502, 504, 615, 502, + 206, 4, 5, 445, 506, 507, 264, 300, 301, 302, + 303, 3, 333, 334, 335, 365, 191, 367, 368, 673, + 400, 400, 143, 264, 408, 409, 191, 433, 434, 435, + 502, 522, 523, 524, 473, 507, 517, 518, 519, 520, + 146, 502, 445, 199, 245, 168, 169, 191, 261, 262, + 543, 548, 549, 552, 555, 556, 262, 548, 104, 561, + 562, 566, 3, 154, 655, 721, 405, 642, 649, 502, + 533, 502, 206, 206, 206, 459, 595, 193, 58, 65, + 67, 68, 502, 592, 628, 629, 206, 58, 65, 67, + 68, 592, 625, 626, 206, 476, 231, 725, 206, 48, + 206, 661, 662, 245, 502, 193, 21, 50, 58, 60, + 61, 62, 63, 65, 67, 191, 435, 439, 591, 592, + 593, 612, 613, 614, 615, 612, 615, 688, 260, 514, + 525, 526, 528, 531, 532, 136, 193, 580, 131, 572, + 577, 538, 194, 685, 206, 715, 709, 698, 405, 704, + 405, 711, 5, 194, 263, 5, 5, 3, 194, 325, + 502, 150, 3, 191, 192, 277, 277, 174, 279, 194, + 263, 316, 202, 324, 276, 484, 484, 485, 486, 490, + 494, 495, 496, 194, 681, 191, 395, 396, 231, 421, + 436, 444, 446, 452, 418, 193, 537, 5, 206, 676, + 3, 206, 22, 191, 191, 430, 431, 3, 206, 193, + 3, 370, 427, 373, 376, 231, 275, 276, 278, 279, + 288, 313, 314, 317, 345, 375, 381, 384, 385, 433, + 489, 680, 206, 545, 206, 545, 4, 21, 154, 231, + 454, 455, 457, 502, 505, 206, 3, 206, 194, 110, + 502, 194, 4, 3, 154, 304, 173, 299, 302, 25, + 101, 130, 132, 133, 134, 137, 138, 140, 141, 336, + 346, 191, 339, 340, 342, 154, 3, 206, 3, 191, + 389, 231, 341, 401, 402, 403, 404, 426, 407, 193, + 3, 206, 199, 206, 4, 3, 194, 3, 194, 435, + 521, 206, 194, 448, 206, 545, 4, 113, 38, 127, + 129, 259, 458, 475, 514, 525, 553, 569, 586, 588, + 594, 601, 605, 608, 611, 624, 627, 630, 682, 547, + 543, 556, 259, 193, 105, 562, 563, 564, 567, 538, + 134, 666, 191, 206, 182, 194, 194, 436, 446, 451, + 466, 467, 468, 49, 53, 54, 55, 56, 57, 58, + 65, 66, 67, 592, 597, 598, 49, 51, 52, 53, + 54, 56, 58, 59, 65, 67, 69, 592, 634, 635, + 592, 260, 435, 442, 443, 435, 440, 441, 600, 3, + 194, 592, 260, 442, 600, 3, 194, 468, 478, 3, + 194, 193, 248, 249, 250, 696, 707, 182, 194, 602, + 5, 21, 591, 615, 191, 613, 260, 260, 260, 442, + 3, 194, 194, 3, 206, 231, 689, 39, 529, 534, + 581, 191, 206, 191, 578, 684, 231, 254, 435, 502, + 690, 691, 692, 21, 191, 701, 716, 717, 718, 206, + 716, 182, 182, 512, 194, 263, 512, 512, 3, 326, + 231, 258, 275, 278, 282, 690, 5, 3, 194, 3, + 193, 502, 502, 679, 231, 414, 415, 436, 22, 193, + 3, 428, 296, 191, 297, 298, 231, 379, 380, 546, + 206, 373, 193, 21, 382, 382, 193, 3, 22, 382, + 276, 279, 206, 206, 4, 502, 260, 502, 5, 3, + 194, 4, 154, 456, 193, 502, 618, 619, 620, 103, + 502, 206, 506, 101, 130, 138, 305, 306, 346, 231, + 307, 308, 191, 206, 193, 193, 3, 332, 193, 347, + 336, 368, 193, 3, 388, 399, 3, 206, 191, 410, + 411, 409, 191, 522, 474, 507, 473, 519, 473, 520, + 146, 206, 206, 169, 191, 206, 193, 191, 192, 193, + 723, 193, 110, 262, 557, 547, 502, 191, 206, 106, + 562, 568, 538, 154, 3, 667, 114, 644, 206, 532, + 575, 3, 461, 193, 469, 503, 504, 599, 503, 503, + 503, 507, 5, 592, 260, 503, 442, 3, 194, 599, + 5, 442, 440, 440, 442, 592, 435, 437, 438, 260, + 442, 437, 3, 194, 629, 206, 626, 206, 3, 479, + 231, 502, 250, 30, 664, 253, 259, 260, 57, 58, + 65, 67, 592, 603, 604, 507, 614, 609, 618, 193, + 435, 606, 616, 617, 620, 616, 533, 40, 41, 535, + 536, 527, 4, 502, 582, 583, 584, 206, 579, 206, + 206, 5, 3, 194, 194, 3, 194, 31, 706, 29, + 713, 194, 3, 194, 3, 194, 194, 231, 328, 329, + 546, 194, 194, 502, 509, 396, 394, 420, 421, 445, + 194, 3, 3, 413, 432, 431, 424, 427, 3, 194, + 5, 193, 231, 255, 256, 257, 258, 275, 278, 313, + 317, 345, 383, 384, 194, 254, 318, 319, 320, 435, + 502, 521, 524, 381, 502, 4, 21, 502, 455, 4, + 502, 502, 502, 617, 619, 620, 621, 622, 3, 206, + 206, 194, 193, 3, 154, 193, 309, 3, 206, 206, + 337, 338, 340, 206, 348, 21, 283, 390, 191, 206, + 206, 403, 20, 3, 194, 4, 4, 521, 206, 545, + 206, 533, 11, 19, 20, 44, 109, 155, 165, 166, + 184, 185, 187, 188, 192, 214, 215, 219, 221, 224, + 226, 231, 232, 233, 502, 725, 502, 253, 194, 206, + 191, 206, 27, 191, 668, 669, 653, 191, 645, 206, + 97, 145, 462, 463, 467, 194, 470, 471, 472, 473, + 503, 598, 596, 440, 194, 635, 631, 97, 145, 468, + 480, 481, 194, 194, 191, 665, 110, 3, 5, 592, + 260, 442, 3, 194, 206, 610, 206, 3, 607, 206, + 194, 191, 206, 191, 206, 527, 584, 3, 194, 4, + 206, 231, 692, 691, 686, 718, 26, 702, 703, 645, + 645, 94, 73, 194, 5, 206, 3, 194, 194, 502, + 415, 206, 427, 4, 349, 350, 351, 352, 353, 354, + 355, 356, 357, 358, 359, 360, 361, 362, 507, 508, + 206, 426, 298, 206, 512, 231, 275, 5, 3, 194, + 502, 260, 502, 4, 3, 619, 103, 4, 310, 350, + 352, 356, 306, 310, 283, 308, 349, 157, 158, 159, + 363, 349, 287, 5, 146, 343, 344, 349, 193, 191, + 411, 206, 206, 194, 502, 194, 194, 502, 199, 444, + 446, 193, 193, 194, 191, 184, 234, 444, 5, 6, + 7, 8, 9, 10, 12, 13, 14, 15, 16, 17, + 19, 20, 21, 22, 23, 195, 196, 216, 194, 194, + 103, 206, 4, 146, 3, 206, 643, 440, 465, 5, + 3, 460, 3, 194, 474, 4, 206, 618, 206, 465, + 5, 3, 477, 574, 663, 502, 260, 503, 604, 206, + 206, 617, 206, 191, 206, 206, 206, 583, 584, 206, + 193, 699, 712, 712, 5, 5, 507, 421, 3, 22, + 194, 3, 4, 3, 3, 352, 360, 508, 21, 3, + 429, 3, 320, 319, 502, 546, 622, 623, 206, 194, + 3, 4, 194, 5, 146, 311, 312, 194, 194, 194, + 509, 313, 345, 433, 194, 391, 724, 222, 223, 225, + 5, 218, 502, 502, 502, 502, 502, 502, 502, 502, + 502, 502, 502, 502, 502, 502, 502, 5, 22, 217, + 502, 502, 5, 502, 5, 502, 191, 206, 191, 656, + 669, 670, 671, 672, 673, 191, 669, 206, 442, 464, + 463, 206, 471, 632, 464, 481, 206, 206, 206, 194, + 3, 206, 191, 206, 705, 206, 512, 263, 3, 502, + 191, 351, 353, 508, 4, 352, 355, 357, 4, 21, + 362, 430, 512, 5, 194, 509, 313, 345, 349, 219, + 231, 220, 227, 227, 227, 502, 502, 502, 502, 502, + 206, 654, 3, 206, 260, 194, 206, 194, 194, 507, + 22, 4, 3, 194, 507, 194, 193, 4, 228, 229, + 230, 502, 194, 194, 194, 206, 671, 206, 3, 414, + 512, 3, 4, 502, 3, 4, 444, 507, 194, 507, + 502, 4, 229, 502, 3, 502, 4, 507, 502 +}; + +#define yyerrok (yyerrstatus = 0) +#define yyclearin (yychar = YYEMPTY) +#define YYEMPTY (-2) +#define YYEOF 0 + +#define YYACCEPT goto yyacceptlab +#define YYABORT goto yyabortlab +#define YYERROR goto yyerrorlab + + +/* Like YYERROR except do call yyerror. This remains here temporarily + to ease the transition to the new meaning of YYERROR, for GCC. + Once GCC version 2 has supplanted version 1, this can go. However, + YYFAIL appears to be in use. Nevertheless, it is formally deprecated + in Bison 2.4.2's NEWS entry, where a plan to phase it out is + discussed. */ + +#define YYFAIL goto yyerrlab +#if defined YYFAIL + /* This is here to suppress warnings from the GCC cpp's + -Wunused-macros. Normally we don't worry about that warning, but + some users do, and we want to make it easy for users to remove + YYFAIL uses, which will produce warnings from Bison 2.5. */ +#endif + +#define YYRECOVERING() (!!yyerrstatus) + +#define YYBACKUP(Token, Value) \ +do \ + if (yychar == YYEMPTY) \ + { \ + yychar = (Token); \ + yylval = (Value); \ + YYPOPSTACK (yylen); \ + yystate = *yyssp; \ + goto yybackup; \ + } \ + else \ + { \ + yyerror (YY_("syntax error: cannot back up")); \ + YYERROR; \ + } \ +while (YYID (0)) + +/* Error token number */ +#define YYTERROR 1 +#define YYERRCODE 256 + + +/* This macro is provided for backward compatibility. */ +#ifndef YY_LOCATION_PRINT +# define YY_LOCATION_PRINT(File, Loc) ((void) 0) +#endif + + +/* YYLEX -- calling `yylex' with the right arguments. */ +#ifdef YYLEX_PARAM +# define YYLEX yylex (YYLEX_PARAM) +#else +# define YYLEX yylex () +#endif + +/* Enable debugging if requested. */ +#if YYDEBUG + +# ifndef YYFPRINTF +# include /* INFRINGES ON USER NAME SPACE */ +# define YYFPRINTF fprintf +# endif + +# define YYDPRINTF(Args) \ +do { \ + if (yydebug) \ + YYFPRINTF Args; \ +} while (YYID (0)) + +# define YY_SYMBOL_PRINT(Title, Type, Value, Location) \ +do { \ + if (yydebug) \ + { \ + YYFPRINTF (stderr, "%s ", Title); \ + yy_symbol_print (stderr, \ + Type, Value); \ + YYFPRINTF (stderr, "\n"); \ + } \ +} while (YYID (0)) + + +/*--------------------------------. +| Print this symbol on YYOUTPUT. | +`--------------------------------*/ + +/*ARGSUSED*/ +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +static void +yy_symbol_value_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep) +#else +static void +yy_symbol_value_print (yyoutput, yytype, yyvaluep) + FILE *yyoutput; + int yytype; + YYSTYPE const * const yyvaluep; +#endif +{ + FILE *yyo = yyoutput; + YYUSE (yyo); + if (!yyvaluep) + return; +# ifdef YYPRINT + if (yytype < YYNTOKENS) + YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep); +# else + YYUSE (yyoutput); +# endif + switch (yytype) + { + default: + break; + } +} + + +/*--------------------------------. +| Print this symbol on YYOUTPUT. | +`--------------------------------*/ + +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +static void +yy_symbol_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep) +#else +static void +yy_symbol_print (yyoutput, yytype, yyvaluep) + FILE *yyoutput; + int yytype; + YYSTYPE const * const yyvaluep; +#endif +{ + if (yytype < YYNTOKENS) + YYFPRINTF (yyoutput, "token %s (", yytname[yytype]); + else + YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]); + + yy_symbol_value_print (yyoutput, yytype, yyvaluep); + YYFPRINTF (yyoutput, ")"); +} + +/*------------------------------------------------------------------. +| yy_stack_print -- Print the state stack from its BOTTOM up to its | +| TOP (included). | +`------------------------------------------------------------------*/ + +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +static void +yy_stack_print (yytype_int16 *yybottom, yytype_int16 *yytop) +#else +static void +yy_stack_print (yybottom, yytop) + yytype_int16 *yybottom; + yytype_int16 *yytop; +#endif +{ + YYFPRINTF (stderr, "Stack now"); + for (; yybottom <= yytop; yybottom++) + { + int yybot = *yybottom; + YYFPRINTF (stderr, " %d", yybot); + } + YYFPRINTF (stderr, "\n"); +} + +# define YY_STACK_PRINT(Bottom, Top) \ +do { \ + if (yydebug) \ + yy_stack_print ((Bottom), (Top)); \ +} while (YYID (0)) + + +/*------------------------------------------------. +| Report that the YYRULE is going to be reduced. | +`------------------------------------------------*/ + +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +static void +yy_reduce_print (YYSTYPE *yyvsp, int yyrule) +#else +static void +yy_reduce_print (yyvsp, yyrule) + YYSTYPE *yyvsp; + int yyrule; +#endif +{ + int yynrhs = yyr2[yyrule]; + int yyi; + unsigned long int yylno = yyrline[yyrule]; + YYFPRINTF (stderr, "Reducing stack by rule %d (line %lu):\n", + yyrule - 1, yylno); + /* The symbols being reduced. */ + for (yyi = 0; yyi < yynrhs; yyi++) + { + YYFPRINTF (stderr, " $%d = ", yyi + 1); + yy_symbol_print (stderr, yyrhs[yyprhs[yyrule] + yyi], + &(yyvsp[(yyi + 1) - (yynrhs)]) + ); + YYFPRINTF (stderr, "\n"); + } +} + +# define YY_REDUCE_PRINT(Rule) \ +do { \ + if (yydebug) \ + yy_reduce_print (yyvsp, Rule); \ +} while (YYID (0)) + +/* Nonzero means print parse trace. It is left uninitialized so that + multiple parsers can coexist. */ +int yydebug; +#else /* !YYDEBUG */ +# define YYDPRINTF(Args) +# define YY_SYMBOL_PRINT(Title, Type, Value, Location) +# define YY_STACK_PRINT(Bottom, Top) +# define YY_REDUCE_PRINT(Rule) +#endif /* !YYDEBUG */ + + +/* YYINITDEPTH -- initial size of the parser's stacks. */ +#ifndef YYINITDEPTH +# define YYINITDEPTH 200 +#endif + +/* YYMAXDEPTH -- maximum size the stacks can grow to (effective only + if the built-in stack extension method is used). + + Do not make this value too large; the results are undefined if + YYSTACK_ALLOC_MAXIMUM < YYSTACK_BYTES (YYMAXDEPTH) + evaluated with infinite-precision integer arithmetic. */ + +#ifndef YYMAXDEPTH +# define YYMAXDEPTH 10000 +#endif + + +#if YYERROR_VERBOSE + +# ifndef yystrlen +# if defined __GLIBC__ && defined _STRING_H +# define yystrlen strlen +# else +/* Return the length of YYSTR. */ +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +static YYSIZE_T +yystrlen (const char *yystr) +#else +static YYSIZE_T +yystrlen (yystr) + const char *yystr; +#endif +{ + YYSIZE_T yylen; + for (yylen = 0; yystr[yylen]; yylen++) + continue; + return yylen; +} +# endif +# endif + +# ifndef yystpcpy +# if defined __GLIBC__ && defined _STRING_H && defined _GNU_SOURCE +# define yystpcpy stpcpy +# else +/* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in + YYDEST. */ +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +static char * +yystpcpy (char *yydest, const char *yysrc) +#else +static char * +yystpcpy (yydest, yysrc) + char *yydest; + const char *yysrc; +#endif +{ + char *yyd = yydest; + const char *yys = yysrc; + + while ((*yyd++ = *yys++) != '\0') + continue; + + return yyd - 1; +} +# endif +# endif + +# ifndef yytnamerr +/* Copy to YYRES the contents of YYSTR after stripping away unnecessary + quotes and backslashes, so that it's suitable for yyerror. The + heuristic is that double-quoting is unnecessary unless the string + contains an apostrophe, a comma, or backslash (other than + backslash-backslash). YYSTR is taken from yytname. If YYRES is + null, do not copy; instead, return the length of what the result + would have been. */ +static YYSIZE_T +yytnamerr (char *yyres, const char *yystr) +{ + if (*yystr == '"') + { + YYSIZE_T yyn = 0; + char const *yyp = yystr; + + for (;;) + switch (*++yyp) + { + case '\'': + case ',': + goto do_not_strip_quotes; + + case '\\': + if (*++yyp != '\\') + goto do_not_strip_quotes; + /* Fall through. */ + default: + if (yyres) + yyres[yyn] = *yyp; + yyn++; + break; + + case '"': + if (yyres) + yyres[yyn] = '\0'; + return yyn; + } + do_not_strip_quotes: ; + } + + if (! yyres) + return yystrlen (yystr); + + return yystpcpy (yyres, yystr) - yyres; +} +# endif + +/* Copy into *YYMSG, which is of size *YYMSG_ALLOC, an error message + about the unexpected token YYTOKEN for the state stack whose top is + YYSSP. + + Return 0 if *YYMSG was successfully written. Return 1 if *YYMSG is + not large enough to hold the message. In that case, also set + *YYMSG_ALLOC to the required number of bytes. Return 2 if the + required number of bytes is too large to store. */ +static int +yysyntax_error (YYSIZE_T *yymsg_alloc, char **yymsg, + yytype_int16 *yyssp, int yytoken) +{ + YYSIZE_T yysize0 = yytnamerr (YY_NULL, yytname[yytoken]); + YYSIZE_T yysize = yysize0; + enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 }; + /* Internationalized format string. */ + const char *yyformat = YY_NULL; + /* Arguments of yyformat. */ + char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM]; + /* Number of reported tokens (one for the "unexpected", one per + "expected"). */ + int yycount = 0; + + /* There are many possibilities here to consider: + - Assume YYFAIL is not used. It's too flawed to consider. See + + for details. YYERROR is fine as it does not invoke this + function. + - If this state is a consistent state with a default action, then + the only way this function was invoked is if the default action + is an error action. In that case, don't check for expected + tokens because there are none. + - The only way there can be no lookahead present (in yychar) is if + this state is a consistent state with a default action. Thus, + detecting the absence of a lookahead is sufficient to determine + that there is no unexpected or expected token to report. In that + case, just report a simple "syntax error". + - Don't assume there isn't a lookahead just because this state is a + consistent state with a default action. There might have been a + previous inconsistent state, consistent state with a non-default + action, or user semantic action that manipulated yychar. + - Of course, the expected token list depends on states to have + correct lookahead information, and it depends on the parser not + to perform extra reductions after fetching a lookahead from the + scanner and before detecting a syntax error. Thus, state merging + (from LALR or IELR) and default reductions corrupt the expected + token list. However, the list is correct for canonical LR with + one exception: it will still contain any token that will not be + accepted due to an error action in a later state. + */ + if (yytoken != YYEMPTY) + { + int yyn = yypact[*yyssp]; + yyarg[yycount++] = yytname[yytoken]; + if (!yypact_value_is_default (yyn)) + { + /* Start YYX at -YYN if negative to avoid negative indexes in + YYCHECK. In other words, skip the first -YYN actions for + this state because they are default actions. */ + int yyxbegin = yyn < 0 ? -yyn : 0; + /* Stay within bounds of both yycheck and yytname. */ + int yychecklim = YYLAST - yyn + 1; + int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS; + int yyx; + + for (yyx = yyxbegin; yyx < yyxend; ++yyx) + if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR + && !yytable_value_is_error (yytable[yyx + yyn])) + { + if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM) + { + yycount = 1; + yysize = yysize0; + break; + } + yyarg[yycount++] = yytname[yyx]; + { + YYSIZE_T yysize1 = yysize + yytnamerr (YY_NULL, yytname[yyx]); + if (! (yysize <= yysize1 + && yysize1 <= YYSTACK_ALLOC_MAXIMUM)) + return 2; + yysize = yysize1; + } + } + } + } + + switch (yycount) + { +# define YYCASE_(N, S) \ + case N: \ + yyformat = S; \ + break + YYCASE_(0, YY_("syntax error")); + YYCASE_(1, YY_("syntax error, unexpected %s")); + YYCASE_(2, YY_("syntax error, unexpected %s, expecting %s")); + YYCASE_(3, YY_("syntax error, unexpected %s, expecting %s or %s")); + YYCASE_(4, YY_("syntax error, unexpected %s, expecting %s or %s or %s")); + YYCASE_(5, YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s")); +# undef YYCASE_ + } + + { + YYSIZE_T yysize1 = yysize + yystrlen (yyformat); + if (! (yysize <= yysize1 && yysize1 <= YYSTACK_ALLOC_MAXIMUM)) + return 2; + yysize = yysize1; + } + + if (*yymsg_alloc < yysize) + { + *yymsg_alloc = 2 * yysize; + if (! (yysize <= *yymsg_alloc + && *yymsg_alloc <= YYSTACK_ALLOC_MAXIMUM)) + *yymsg_alloc = YYSTACK_ALLOC_MAXIMUM; + return 1; + } + + /* Avoid sprintf, as that infringes on the user's name space. + Don't have undefined behavior even if the translation + produced a string with the wrong number of "%s"s. */ + { + char *yyp = *yymsg; + int yyi = 0; + while ((*yyp = *yyformat) != '\0') + if (*yyp == '%' && yyformat[1] == 's' && yyi < yycount) + { + yyp += yytnamerr (yyp, yyarg[yyi++]); + yyformat += 2; + } + else + { + yyp++; + yyformat++; + } + } + return 0; +} +#endif /* YYERROR_VERBOSE */ + +/*-----------------------------------------------. +| Release the memory associated to this symbol. | +`-----------------------------------------------*/ + +/*ARGSUSED*/ +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +static void +yydestruct (const char *yymsg, int yytype, YYSTYPE *yyvaluep) +#else +static void +yydestruct (yymsg, yytype, yyvaluep) + const char *yymsg; + int yytype; + YYSTYPE *yyvaluep; +#endif +{ + YYUSE (yyvaluep); + + if (!yymsg) + yymsg = "Deleting"; + YY_SYMBOL_PRINT (yymsg, yytype, yyvaluep, yylocationp); + + switch (yytype) + { + + default: + break; + } +} + + + + +/* The lookahead symbol. */ +int yychar; + + +#ifndef YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN +# define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN +# define YY_IGNORE_MAYBE_UNINITIALIZED_END +#endif +#ifndef YY_INITIAL_VALUE +# define YY_INITIAL_VALUE(Value) /* Nothing. */ +#endif + +/* The semantic value of the lookahead symbol. */ +YYSTYPE yylval YY_INITIAL_VALUE(yyval_default); + +/* Number of syntax errors so far. */ +int yynerrs; + + +/*----------. +| yyparse. | +`----------*/ + +#ifdef YYPARSE_PARAM +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +int +yyparse (void *YYPARSE_PARAM) +#else +int +yyparse (YYPARSE_PARAM) + void *YYPARSE_PARAM; +#endif +#else /* ! YYPARSE_PARAM */ +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +int +yyparse (void) +#else +int +yyparse () + +#endif +#endif +{ + int yystate; + /* Number of tokens to shift before error messages enabled. */ + int yyerrstatus; + + /* The stacks and their tools: + `yyss': related to states. + `yyvs': related to semantic values. + + Refer to the stacks through separate pointers, to allow yyoverflow + to reallocate them elsewhere. */ + + /* The state stack. */ + yytype_int16 yyssa[YYINITDEPTH]; + yytype_int16 *yyss; + yytype_int16 *yyssp; + + /* The semantic value stack. */ + YYSTYPE yyvsa[YYINITDEPTH]; + YYSTYPE *yyvs; + YYSTYPE *yyvsp; + + YYSIZE_T yystacksize; + + int yyn; + int yyresult; + /* Lookahead token as an internal (translated) token number. */ + int yytoken = 0; + /* The variables used to return semantic value and location from the + action routines. */ + YYSTYPE yyval; + +#if YYERROR_VERBOSE + /* Buffer for error messages, and its allocated size. */ + char yymsgbuf[128]; + char *yymsg = yymsgbuf; + YYSIZE_T yymsg_alloc = sizeof yymsgbuf; +#endif + +#define YYPOPSTACK(N) (yyvsp -= (N), yyssp -= (N)) + + /* The number of symbols on the RHS of the reduced rule. + Keep to zero when no symbol should be popped. */ + int yylen = 0; + + yyssp = yyss = yyssa; + yyvsp = yyvs = yyvsa; + yystacksize = YYINITDEPTH; + + YYDPRINTF ((stderr, "Starting parse\n")); + + yystate = 0; + yyerrstatus = 0; + yynerrs = 0; + yychar = YYEMPTY; /* Cause a token to be read. */ + goto yysetstate; + +/*------------------------------------------------------------. +| yynewstate -- Push a new state, which is found in yystate. | +`------------------------------------------------------------*/ + yynewstate: + /* In all cases, when you get here, the value and location stacks + have just been pushed. So pushing a state here evens the stacks. */ + yyssp++; + + yysetstate: + *yyssp = yystate; + + if (yyss + yystacksize - 1 <= yyssp) + { + /* Get the current used size of the three stacks, in elements. */ + YYSIZE_T yysize = yyssp - yyss + 1; + +#ifdef yyoverflow + { + /* Give user a chance to reallocate the stack. Use copies of + these so that the &'s don't force the real ones into + memory. */ + YYSTYPE *yyvs1 = yyvs; + yytype_int16 *yyss1 = yyss; + + /* Each stack pointer address is followed by the size of the + data in use in that stack, in bytes. This used to be a + conditional around just the two extra args, but that might + be undefined if yyoverflow is a macro. */ + yyoverflow (YY_("memory exhausted"), + &yyss1, yysize * sizeof (*yyssp), + &yyvs1, yysize * sizeof (*yyvsp), + &yystacksize); + + yyss = yyss1; + yyvs = yyvs1; + } +#else /* no yyoverflow */ +# ifndef YYSTACK_RELOCATE + goto yyexhaustedlab; +# else + /* Extend the stack our own way. */ + if (YYMAXDEPTH <= yystacksize) + goto yyexhaustedlab; + yystacksize *= 2; + if (YYMAXDEPTH < yystacksize) + yystacksize = YYMAXDEPTH; + + { + yytype_int16 *yyss1 = yyss; + union yyalloc *yyptr = + (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize)); + if (! yyptr) + goto yyexhaustedlab; + YYSTACK_RELOCATE (yyss_alloc, yyss); + YYSTACK_RELOCATE (yyvs_alloc, yyvs); +# undef YYSTACK_RELOCATE + if (yyss1 != yyssa) + YYSTACK_FREE (yyss1); + } +# endif +#endif /* no yyoverflow */ + + yyssp = yyss + yysize - 1; + yyvsp = yyvs + yysize - 1; + + YYDPRINTF ((stderr, "Stack size increased to %lu\n", + (unsigned long int) yystacksize)); + + if (yyss + yystacksize - 1 <= yyssp) + YYABORT; + } + + YYDPRINTF ((stderr, "Entering state %d\n", yystate)); + + if (yystate == YYFINAL) + YYACCEPT; + + goto yybackup; + +/*-----------. +| yybackup. | +`-----------*/ +yybackup: + + /* Do appropriate processing given the current state. Read a + lookahead token if we need one and don't already have one. */ + + /* First try to decide what to do without reference to lookahead token. */ + yyn = yypact[yystate]; + if (yypact_value_is_default (yyn)) + goto yydefault; + + /* Not known => get a lookahead token if don't already have one. */ + + /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */ + if (yychar == YYEMPTY) + { + YYDPRINTF ((stderr, "Reading a token: ")); + yychar = YYLEX; + } + + if (yychar <= YYEOF) + { + yychar = yytoken = YYEOF; + YYDPRINTF ((stderr, "Now at end of input.\n")); + } + else + { + yytoken = YYTRANSLATE (yychar); + YY_SYMBOL_PRINT ("Next token is", yytoken, &yylval, &yylloc); + } + + /* If the proper action on seeing token YYTOKEN is to reduce or to + detect an error, take that action. */ + yyn += yytoken; + if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken) + goto yydefault; + yyn = yytable[yyn]; + if (yyn <= 0) + { + if (yytable_value_is_error (yyn)) + goto yyerrlab; + yyn = -yyn; + goto yyreduce; + } + + /* Count tokens shifted since error; after three, turn off error + status. */ + if (yyerrstatus) + yyerrstatus--; + + /* Shift the lookahead token. */ + YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc); + + /* Discard the shifted token. */ + yychar = YYEMPTY; + + yystate = yyn; + YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN + *++yyvsp = yylval; + YY_IGNORE_MAYBE_UNINITIALIZED_END + + goto yynewstate; + + +/*-----------------------------------------------------------. +| yydefault -- do the default action for the current state. | +`-----------------------------------------------------------*/ +yydefault: + yyn = yydefact[yystate]; + if (yyn == 0) + goto yyerrlab; + goto yyreduce; + + +/*-----------------------------. +| yyreduce -- Do a reduction. | +`-----------------------------*/ +yyreduce: + /* yyn is the number of a rule to reduce with. */ + yylen = yyr2[yyn]; + + /* If YYLEN is nonzero, implement the default value of the action: + `$$ = $1'. + + Otherwise, the following line sets YYVAL to garbage. + This behavior is undocumented and Bison + users should not rely upon it. Assigning to YYVAL + unconditionally makes the parser a bit smaller, and it avoids a + GCC warning that YYVAL may be used uninitialized. */ + yyval = yyvsp[1-yylen]; + + + YY_REDUCE_PRINT (yyn); + switch (yyn) + { + case 6: +/* Line 1807 of yacc.c */ +#line 518 "fortran.y" + {yyerrok;yyclearin;} + break; + + case 7: +/* Line 1807 of yacc.c */ +#line 521 "fortran.y" + {token_since_endofstmt = 0; increment_nbtokens = 0;} + break; + + case 16: +/* Line 1807 of yacc.c */ +#line 534 "fortran.y" + { + if (inmoduledeclare == 0 ) + { + pos_end = setposcur(); + RemoveWordSET_0(fortran_out,pos_curinclude,pos_end-pos_curinclude); + } + } + break; + + case 18: +/* Line 1807 of yacc.c */ +#line 559 "fortran.y" + { pos_cur = setposcur(); } + break; + + case 24: +/* Line 1807 of yacc.c */ +#line 583 "fortran.y" + { Add_Include_1((yyvsp[(1) - (1)].na)); } + break; + + case 27: +/* Line 1807 of yacc.c */ +#line 1103 "fortran.y" + { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); } + break; + + case 28: +/* Line 1807 of yacc.c */ +#line 1104 "fortran.y" + { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); } + break; + + case 29: +/* Line 1807 of yacc.c */ +#line 1105 "fortran.y" + { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); } + break; + + case 30: +/* Line 1807 of yacc.c */ +#line 1106 "fortran.y" + { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); } + break; + + case 31: +/* Line 1807 of yacc.c */ +#line 1107 "fortran.y" + { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); } + break; + + case 32: +/* Line 1807 of yacc.c */ +#line 1109 "fortran.y" + { strcpy((yyval.na),"+"); } + break; + + case 33: +/* Line 1807 of yacc.c */ +#line 1110 "fortran.y" + { strcpy((yyval.na),"-"); } + break; + + case 34: +/* Line 1807 of yacc.c */ +#line 1114 "fortran.y" + { sprintf((yyval.na),"+%s",(yyvsp[(2) - (2)].na)); } + break; + + case 35: +/* Line 1807 of yacc.c */ +#line 1115 "fortran.y" + { sprintf((yyval.na),"-%s",(yyvsp[(2) - (2)].na)); } + break; + + case 36: +/* Line 1807 of yacc.c */ +#line 1116 "fortran.y" + { sprintf((yyval.na),"*%s",(yyvsp[(2) - (2)].na)); } + break; + + case 37: +/* Line 1807 of yacc.c */ +#line 1117 "fortran.y" + { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); } + break; + + case 38: +/* Line 1807 of yacc.c */ +#line 1118 "fortran.y" + { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); } + break; + + case 39: +/* Line 1807 of yacc.c */ +#line 1119 "fortran.y" + { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); } + break; + + case 40: +/* Line 1807 of yacc.c */ +#line 1120 "fortran.y" + { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); } + break; + + case 41: +/* Line 1807 of yacc.c */ +#line 1121 "fortran.y" + { sprintf((yyval.na)," > %s",(yyvsp[(2) - (2)].na)); } + break; + + case 42: +/* Line 1807 of yacc.c */ +#line 1122 "fortran.y" + { sprintf((yyval.na)," < %s",(yyvsp[(2) - (2)].na)); } + break; + + case 43: +/* Line 1807 of yacc.c */ +#line 1123 "fortran.y" + { sprintf((yyval.na)," >= %s",(yyvsp[(3) - (3)].na)); } + break; + + case 44: +/* Line 1807 of yacc.c */ +#line 1124 "fortran.y" + { sprintf((yyval.na)," <= %s",(yyvsp[(3) - (3)].na)); } + break; + + case 45: +/* Line 1807 of yacc.c */ +#line 1125 "fortran.y" + { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); } + break; + + case 46: +/* Line 1807 of yacc.c */ +#line 1126 "fortran.y" + { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); } + break; + + case 47: +/* Line 1807 of yacc.c */ +#line 1127 "fortran.y" + { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); } + break; + + case 48: +/* Line 1807 of yacc.c */ +#line 1128 "fortran.y" + { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); } + break; + + case 49: +/* Line 1807 of yacc.c */ +#line 1129 "fortran.y" + { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); } + break; + + case 50: +/* Line 1807 of yacc.c */ +#line 1130 "fortran.y" + { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); } + break; + + case 51: +/* Line 1807 of yacc.c */ +#line 1131 "fortran.y" + { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); } + break; + + case 52: +/* Line 1807 of yacc.c */ +#line 1132 "fortran.y" + { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); } + break; + + case 53: +/* Line 1807 of yacc.c */ +#line 1133 "fortran.y" + { sprintf((yyval.na),"%s",(yyvsp[(2) - (2)].na)); } + break; + + case 54: +/* Line 1807 of yacc.c */ +#line 1134 "fortran.y" + { sprintf((yyval.na),"%s",(yyvsp[(2) - (2)].na)); } + break; + + case 55: +/* Line 1807 of yacc.c */ +#line 1136 "fortran.y" + { strcpy((yyval.na),""); } + break; + + case 56: +/* Line 1807 of yacc.c */ +#line 1137 "fortran.y" + { sprintf((yyval.na),"/%s",(yyvsp[(1) - (1)].na)); } + break; + + case 57: +/* Line 1807 of yacc.c */ +#line 1138 "fortran.y" + { sprintf((yyval.na),"/= %s",(yyvsp[(2) - (2)].na));} + break; + + case 58: +/* Line 1807 of yacc.c */ +#line 1139 "fortran.y" + { sprintf((yyval.na),"//%s",(yyvsp[(2) - (2)].na)); } + break; + + case 59: +/* Line 1807 of yacc.c */ +#line 1142 "fortran.y" + { sprintf((yyval.na),"==%s",(yyvsp[(2) - (2)].na)); } + break; + + case 60: +/* Line 1807 of yacc.c */ +#line 1143 "fortran.y" + { sprintf((yyval.na),"= %s",(yyvsp[(1) - (1)].na)); } + break; + + case 61: +/* Line 1807 of yacc.c */ +#line 1146 "fortran.y" + { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); } + break; + + case 62: +/* Line 1807 of yacc.c */ +#line 1147 "fortran.y" + { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); } + break; + + case 63: +/* Line 1807 of yacc.c */ +#line 1148 "fortran.y" + { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); } + break; + + case 64: +/* Line 1807 of yacc.c */ +#line 1152 "fortran.y" + { + agrif_parentcall = 0; + if ( !strcasecmp(identcopy, "Agrif_Parent") ) agrif_parentcall = 1; + if ( Agrif_in_Tok_NAME(identcopy) ) + { + inagrifcallargument = 1; + Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename); + } + } + break; + + case 65: +/* Line 1807 of yacc.c */ +#line 1163 "fortran.y" + { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); if ( incalldeclare == 0 ) inagrifcallargument = 0; } + break; + + case 66: +/* Line 1807 of yacc.c */ +#line 1164 "fortran.y" + { sprintf((yyval.na)," %s %s ",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); } + break; + + case 67: +/* Line 1807 of yacc.c */ +#line 1165 "fortran.y" + {in_complex_literal=0;} + break; + + case 68: +/* Line 1807 of yacc.c */ +#line 1165 "fortran.y" + { sprintf((yyval.na)," %s ( %s )",(yyvsp[(1) - (5)].na),(yyvsp[(4) - (5)].na)); } + break; + + case 69: +/* Line 1807 of yacc.c */ +#line 1166 "fortran.y" + {in_complex_literal=0;} + break; + + case 70: +/* Line 1807 of yacc.c */ +#line 1166 "fortran.y" + { sprintf((yyval.na)," %s ( %s ) %s ",(yyvsp[(1) - (6)].na),(yyvsp[(4) - (6)].na),(yyvsp[(6) - (6)].na)); } + break; + + case 72: +/* Line 1807 of yacc.c */ +#line 1169 "fortran.y" + {in_complex_literal=0;} + break; + + case 73: +/* Line 1807 of yacc.c */ +#line 1170 "fortran.y" + { + if ( inside_type_declare ) break; + sprintf((yyval.na)," %s ( %s )",(yyvsp[(1) - (5)].na),(yyvsp[(4) - (5)].na)); + ModifyTheAgrifFunction_0((yyvsp[(4) - (5)].na)); + agrif_parentcall = 0; + } + break; + + case 74: +/* Line 1807 of yacc.c */ +#line 1179 "fortran.y" + { + sprintf((yyval.na)," %s %% %s ",(yyvsp[(1) - (4)].na),(yyvsp[(4) - (4)].na)); + if ( incalldeclare == 0 ) inagrifcallargument = 0; + } + break; + + case 75: +/* Line 1807 of yacc.c */ +#line 1190 "fortran.y" + { strcpy((yyval.na)," "); } + break; + + case 76: +/* Line 1807 of yacc.c */ +#line 1191 "fortran.y" + { strcpy((yyval.na),(yyvsp[(2) - (2)].na)); } + break; + + case 77: +/* Line 1807 of yacc.c */ +#line 1194 "fortran.y" + { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); } + break; + + case 78: +/* Line 1807 of yacc.c */ +#line 1195 "fortran.y" + { sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); } + break; + + case 79: +/* Line 1807 of yacc.c */ +#line 1198 "fortran.y" + {strcpy((yyval.na),(yyvsp[(1) - (1)].na));} + break; + + case 80: +/* Line 1807 of yacc.c */ +#line 1199 "fortran.y" + {strcpy((yyval.na),(yyvsp[(1) - (1)].na));} + break; + + case 81: +/* Line 1807 of yacc.c */ +#line 1202 "fortran.y" + { sprintf((yyval.na),"%s :%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));} + break; + + case 82: +/* Line 1807 of yacc.c */ +#line 1203 "fortran.y" + { sprintf((yyval.na),"%s :%s :%s",(yyvsp[(1) - (5)].na),(yyvsp[(3) - (5)].na),(yyvsp[(5) - (5)].na));} + break; + + case 83: +/* Line 1807 of yacc.c */ +#line 1204 "fortran.y" + { sprintf((yyval.na),":%s :%s",(yyvsp[(2) - (4)].na),(yyvsp[(4) - (4)].na));} + break; + + case 84: +/* Line 1807 of yacc.c */ +#line 1205 "fortran.y" + { sprintf((yyval.na),": : %s",(yyvsp[(3) - (3)].na));} + break; + + case 85: +/* Line 1807 of yacc.c */ +#line 1206 "fortran.y" + { sprintf((yyval.na),":%s",(yyvsp[(2) - (2)].na));} + break; + + case 86: +/* Line 1807 of yacc.c */ +#line 1207 "fortran.y" + { sprintf((yyval.na),"%s :",(yyvsp[(1) - (2)].na));} + break; + + case 87: +/* Line 1807 of yacc.c */ +#line 1208 "fortran.y" + { sprintf((yyval.na),":");} + break; + + case 88: +/* Line 1807 of yacc.c */ +#line 1211 "fortran.y" + { + // if (indeclaration == 1) break; + if ( afterpercent == 0 ) + { + if ( Agrif_in_Tok_NAME((yyvsp[(1) - (1)].na)) ) Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename); + if ( !strcasecmp((yyvsp[(1) - (1)].na),"Agrif_Parent") ) agrif_parentcall = 1; + if ( VariableIsFunction((yyvsp[(1) - (1)].na)) ) + { + if ( inagrifcallargument == 1 ) + { + if ( !strcasecmp((yyvsp[(1) - (1)].na),identcopy) ) + { + strcpy(sameagrifname,identcopy); + sameagrifargument = 1; + } + } + strcpy(identcopy,(yyvsp[(1) - (1)].na)); + pointedvar = 0; + + if (variscoupled_0((yyvsp[(1) - (1)].na))) strcpy(truename, getcoupledname_0((yyvsp[(1) - (1)].na))); + else strcpy(truename, (yyvsp[(1) - (1)].na)); + + if ( VarIsNonGridDepend(truename) == 0 && (! Variableshouldberemoved(truename)) ) + { + if ( inagrifcallargument == 1 || varispointer_0(truename) == 1 ) + { + if ( (IsinListe(List_UsedInSubroutine_Var,(yyvsp[(1) - (1)].na)) == 1) || (inagrifcallargument == 1) ) + { + if (varistyped_0(truename) == 0) ModifyTheVariableName_0(truename,strlen((yyvsp[(1) - (1)].na))); + } + } + if ( inagrifcallargument != 1 || sameagrifargument ==1 ) + { + Add_UsedInSubroutine_Var_1(truename); + } + } + NotifyAgrifFunction_0(truename); + } + } + else + { + afterpercent = 0; + } + } + break; + + case 89: +/* Line 1807 of yacc.c */ +#line 1257 "fortran.y" + { strcpy((yyval.na),".TRUE.");} + break; + + case 90: +/* Line 1807 of yacc.c */ +#line 1258 "fortran.y" + { strcpy((yyval.na),".FALSE.");} + break; + + case 91: +/* Line 1807 of yacc.c */ +#line 1259 "fortran.y" + { strcpy((yyval.na),"NULL()"); } + break; + + case 92: +/* Line 1807 of yacc.c */ +#line 1260 "fortran.y" + { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); } + break; + + case 93: +/* Line 1807 of yacc.c */ +#line 1261 "fortran.y" + { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); } + break; + + case 94: +/* Line 1807 of yacc.c */ +#line 1262 "fortran.y" + { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); } + break; + + case 95: +/* Line 1807 of yacc.c */ +#line 1264 "fortran.y" + { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); } + break; + + case 97: +/* Line 1807 of yacc.c */ +#line 1268 "fortran.y" + { strcpy((yyval.na),(yyvsp[(1) - (1)].na));} + break; + + case 99: +/* Line 1807 of yacc.c */ +#line 1270 "fortran.y" + { strcpy((yyval.na),(yyvsp[(1) - (1)].na));} + break; + + case 100: +/* Line 1807 of yacc.c */ +#line 1271 "fortran.y" + { strcpy((yyval.na),(yyvsp[(1) - (1)].na));} + break; + + case 101: +/* Line 1807 of yacc.c */ +#line 1273 "fortran.y" + { strcpy((yyval.na)," ");} + break; + + case 102: +/* Line 1807 of yacc.c */ +#line 1274 "fortran.y" + { strcpy((yyval.na),(yyvsp[(1) - (1)].na));} + break; + + case 103: +/* Line 1807 of yacc.c */ +#line 1284 "fortran.y" + { strcpy((yyval.na)," ");} + break; + + case 104: +/* Line 1807 of yacc.c */ +#line 1285 "fortran.y" + { strcpy((yyval.na),(yyvsp[(1) - (1)].na));} + break; + + case 169: +/* Line 1807 of yacc.c */ +#line 1483 "fortran.y" + { + /* if we never meet the contains keyword */ + if ( firstpass == 0 ) + { + RemoveWordCUR_0(fortran_out, strlen((yyvsp[(2) - (2)].na))+11); // Remove word "end module" + if ( inmoduledeclare && ! aftercontainsdeclare ) + { + Write_Closing_Module(1); + } + fprintf(fortran_out,"\n end module %s\n", curmodulename); + if ( module_declar && insubroutinedeclare == 0 ) + { + fclose(module_declar); + } + } + inmoduledeclare = 0 ; + inmodulemeet = 0 ; + aftercontainsdeclare = 1; + strcpy(curmodulename, ""); + GlobalDeclaration = 0 ; + } + break; + + case 189: +/* Line 1807 of yacc.c */ +#line 1536 "fortran.y" + {in_complex_literal=0;} + break; + + case 192: +/* Line 1807 of yacc.c */ +#line 1560 "fortran.y" + {strcpy((yyval.na),"");} + break; + + case 196: +/* Line 1807 of yacc.c */ +#line 1570 "fortran.y" + {strcpy((yyval.na),"");} + break; + + case 197: +/* Line 1807 of yacc.c */ +#line 1572 "fortran.y" + {strcpy((yyval.na),(yyvsp[(1) - (1)].na));} + break; + + case 202: +/* Line 1807 of yacc.c */ +#line 1592 "fortran.y" + {pos_cur_decl=my_position_before;} + break; + + case 203: +/* Line 1807 of yacc.c */ +#line 1593 "fortran.y" + {strcpy((yyval.na),(yyvsp[(2) - (2)].na));} + break; + + case 205: +/* Line 1807 of yacc.c */ +#line 1596 "fortran.y" + {strcpy(DeclType,"type"); GlobalDeclarationType = 1; } + break; + + case 206: +/* Line 1807 of yacc.c */ +#line 1600 "fortran.y" + {in_kind_selector = 1;} + break; + + case 207: +/* Line 1807 of yacc.c */ +#line 1601 "fortran.y" + {sprintf((yyval.na),"%s%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));strcpy(DeclType,(yyvsp[(1) - (3)].na)); in_kind_selector =0;} + break; + + case 208: +/* Line 1807 of yacc.c */ +#line 1602 "fortran.y" + {in_kind_selector = 1;} + break; + + case 209: +/* Line 1807 of yacc.c */ +#line 1603 "fortran.y" + {sprintf((yyval.na),"%s%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));strcpy(DeclType,(yyvsp[(1) - (3)].na));in_kind_selector =0;} + break; + + case 210: +/* Line 1807 of yacc.c */ +#line 1604 "fortran.y" + {in_kind_selector = 1;} + break; + + case 211: +/* Line 1807 of yacc.c */ +#line 1605 "fortran.y" + {sprintf((yyval.na),"%s%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));strcpy(DeclType,"real"); strcpy(NamePrecision,"8");in_kind_selector =0;} + break; + + case 212: +/* Line 1807 of yacc.c */ +#line 1606 "fortran.y" + {in_kind_selector = 1;} + break; + + case 213: +/* Line 1807 of yacc.c */ +#line 1607 "fortran.y" + {sprintf((yyval.na),"%s%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));strcpy(DeclType,(yyvsp[(1) - (3)].na));in_kind_selector =0;} + break; + + case 214: +/* Line 1807 of yacc.c */ +#line 1608 "fortran.y" + {in_char_selector = 1;} + break; + + case 215: +/* Line 1807 of yacc.c */ +#line 1609 "fortran.y" + {sprintf((yyval.na),"%s%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));strcpy(DeclType,(yyvsp[(1) - (3)].na));in_char_selector = 0;} + break; + + case 216: +/* Line 1807 of yacc.c */ +#line 1610 "fortran.y" + {in_kind_selector = 1;} + break; + + case 217: +/* Line 1807 of yacc.c */ +#line 1611 "fortran.y" + {sprintf((yyval.na),"%s%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));strcpy(DeclType,(yyvsp[(1) - (3)].na));in_kind_selector =0;} + break; + + case 218: +/* Line 1807 of yacc.c */ +#line 1615 "fortran.y" + {strcpy((yyval.na),"");strcpy(NamePrecision,"");} + break; + + case 219: +/* Line 1807 of yacc.c */ +#line 1617 "fortran.y" + {strcpy((yyval.na),(yyvsp[(1) - (1)].na));} + break; + + case 220: +/* Line 1807 of yacc.c */ +#line 1623 "fortran.y" + {sprintf((yyval.na),"(%s)",(yyvsp[(2) - (3)].na)); strcpy(NamePrecision,(yyvsp[(2) - (3)].na));} + break; + + case 221: +/* Line 1807 of yacc.c */ +#line 1625 "fortran.y" + {sprintf((yyval.na),"(KIND=%s)",(yyvsp[(4) - (5)].na)); strcpy(NamePrecision,(yyvsp[(4) - (5)].na));} + break; + + case 222: +/* Line 1807 of yacc.c */ +#line 1627 "fortran.y" + {sprintf((yyval.na),"*%s",(yyvsp[(2) - (2)].na));strcpy(NamePrecision,(yyvsp[(2) - (2)].na));} + break; + + case 224: +/* Line 1807 of yacc.c */ +#line 1635 "fortran.y" + {sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na));} + break; + + case 226: +/* Line 1807 of yacc.c */ +#line 1641 "fortran.y" + {sprintf((yyval.na),"%s_%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));} + break; + + case 230: +/* Line 1807 of yacc.c */ +#line 1664 "fortran.y" + {sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na));} + break; + + case 232: +/* Line 1807 of yacc.c */ +#line 1670 "fortran.y" + {sprintf((yyval.na),"%s_%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));} + break; + + case 233: +/* Line 1807 of yacc.c */ +#line 1677 "fortran.y" + {sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na));} + break; + + case 241: +/* Line 1807 of yacc.c */ +#line 1695 "fortran.y" + {char_length_toreset = 1;} + break; + + case 242: +/* Line 1807 of yacc.c */ +#line 1699 "fortran.y" + {strcpy((yyval.na),"");} + break; + + case 243: +/* Line 1807 of yacc.c */ +#line 1701 "fortran.y" + {strcpy((yyval.na),"");} + break; + + case 249: +/* Line 1807 of yacc.c */ +#line 1714 "fortran.y" + {strcpy(CharacterSize,(yyvsp[(2) - (3)].na));} + break; + + case 250: +/* Line 1807 of yacc.c */ +#line 1716 "fortran.y" + {strcpy(CharacterSize,(yyvsp[(4) - (5)].na));} + break; + + case 253: +/* Line 1807 of yacc.c */ +#line 1723 "fortran.y" + {c_star=1; strcpy(CharacterSize,(yyvsp[(2) - (3)].na));} + break; + + case 254: +/* Line 1807 of yacc.c */ +#line 1725 "fortran.y" + {c_selectorgiven = 1; strcpy(c_selectorname,(yyvsp[(1) - (1)].na));} + break; + + case 260: +/* Line 1807 of yacc.c */ +#line 1740 "fortran.y" + { inside_type_declare = 1;} + break; + + case 261: +/* Line 1807 of yacc.c */ +#line 1741 "fortran.y" + { inside_type_declare = 0;} + break; + + case 293: +/* Line 1807 of yacc.c */ +#line 1816 "fortran.y" + { + PublicDeclare = 0; + PrivateDeclare = 0; + ExternalDeclare = 0; + strcpy(NamePrecision,""); + c_star = 0; + InitialValueGiven = 0 ; + strcpy(IntentSpec,""); + VariableIsParameter = 0 ; + Allocatabledeclare = 0 ; + Targetdeclare = 0 ; + SaveDeclare = 0; + pointerdeclare = 0; + optionaldeclare = 0 ; + dimsgiven=0; + c_selectorgiven=0; + strcpy(nameinttypename,""); + strcpy(c_selectorname,""); + GlobalDeclarationType = 0; + } + break; + + case 303: +/* Line 1807 of yacc.c */ +#line 1859 "fortran.y" + {strcpy(my_dim.last,"");} + break; + + case 304: +/* Line 1807 of yacc.c */ +#line 1864 "fortran.y" + {strcpy(NamePrecision,(yyvsp[(1) - (1)].na));} + break; + + case 319: +/* Line 1807 of yacc.c */ +#line 1899 "fortran.y" + { sprintf((yyval.na),"(/%s/)",(yyvsp[(2) - (3)].na));} + break; + + case 320: +/* Line 1807 of yacc.c */ +#line 1901 "fortran.y" + { sprintf((yyval.na),"[%s]",(yyvsp[(2) - (3)].na)); } + break; + + case 325: +/* Line 1807 of yacc.c */ +#line 1929 "fortran.y" + {sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));} + break; + + case 328: +/* Line 1807 of yacc.c */ +#line 1939 "fortran.y" + {sprintf((yyval.na),"(%s,%s)",(yyvsp[(2) - (5)].na),(yyvsp[(4) - (5)].na));} + break; + + case 329: +/* Line 1807 of yacc.c */ +#line 1944 "fortran.y" + {sprintf((yyval.na),"%s=%s,%s",(yyvsp[(1) - (5)].na),(yyvsp[(3) - (5)].na),(yyvsp[(5) - (5)].na));} + break; + + case 330: +/* Line 1807 of yacc.c */ +#line 1946 "fortran.y" + {sprintf((yyval.na),"%s=%s,%s,%s",(yyvsp[(1) - (7)].na),(yyvsp[(3) - (7)].na),(yyvsp[(5) - (7)].na),(yyvsp[(7) - (7)].na));} + break; + + case 332: +/* Line 1807 of yacc.c */ +#line 1954 "fortran.y" + {indeclaration=1;} + break; + + case 333: +/* Line 1807 of yacc.c */ +#line 1955 "fortran.y" + { + /* if the variable is a parameter we can suppose that is*/ + /* value is the same on each grid. It is not useless */ + /* to create a copy of it on each grid */ + if ( ! inside_type_declare ) + { + pos_end = setposcur(); + //printf("POS = %d %d\n",pos_cur_decl,pos_end); + RemoveWordSET_0(fortran_out,pos_cur_decl,pos_end-pos_cur_decl); + ReWriteDeclarationAndAddTosubroutine_01((yyvsp[(4) - (4)].l)); + pos_cur_decl = setposcur(); + if ( firstpass == 0 && GlobalDeclaration == 0 + && insubroutinedeclare == 0 ) + { + fprintf(fortran_out,"\n#include \"Module_Declar_%s.h\"\n", curmodulename); + sprintf(ligne, "Module_Declar_%s.h", curmodulename); + module_declar = open_for_write(ligne); + GlobalDeclaration = 1 ; + pos_cur_decl = setposcur(); + } + + if ( firstpass ) + { + Add_Globliste_1((yyvsp[(4) - (4)].l)); + if ( insubroutinedeclare ) + { + if ( pointerdeclare ) Add_Pointer_Var_From_List_1((yyvsp[(4) - (4)].l)); + Add_Parameter_Var_1((yyvsp[(4) - (4)].l)); + } + else + Add_GlobalParameter_Var_1((yyvsp[(4) - (4)].l)); + + /* If there's a SAVE declaration in module's subroutines we should */ + /* remove it from the subroutines declaration and add it in the */ + /* global declarations */ + + if ( aftercontainsdeclare && SaveDeclare ) + { + if ( inmodulemeet ) Add_SubroutineDeclarationSave_Var_1((yyvsp[(4) - (4)].l)); + else Add_Save_Var_dcl_1((yyvsp[(4) - (4)].l)); + } + } + } + indeclaration = 0; + PublicDeclare = 0; + PrivateDeclare = 0; + ExternalDeclare = 0; + strcpy(NamePrecision,""); + c_star = 0; + InitialValueGiven = 0 ; + strcpy(IntentSpec,""); + VariableIsParameter = 0 ; + Allocatabledeclare = 0 ; + Targetdeclare = 0 ; + SaveDeclare = 0; + pointerdeclare = 0; + optionaldeclare = 0 ; + dimsgiven=0; + c_selectorgiven=0; + strcpy(nameinttypename,""); + strcpy(c_selectorname,""); + strcpy(DeclType,""); + GlobalDeclarationType = 0; + } + break; + + case 342: +/* Line 1807 of yacc.c */ +#line 2038 "fortran.y" + { Allocatabledeclare = 1; } + break; + + case 343: +/* Line 1807 of yacc.c */ +#line 2039 "fortran.y" + {in_complex_literal=0;} + break; + + case 344: +/* Line 1807 of yacc.c */ +#line 2040 "fortran.y" + { dimsgiven = 1; curdim = (yyvsp[(4) - (5)].d); } + break; + + case 345: +/* Line 1807 of yacc.c */ +#line 2042 "fortran.y" + { ExternalDeclare = 1; } + break; + + case 346: +/* Line 1807 of yacc.c */ +#line 2043 "fortran.y" + {in_complex_literal=0;} + break; + + case 347: +/* Line 1807 of yacc.c */ +#line 2044 "fortran.y" + { strcpy(IntentSpec,(yyvsp[(4) - (5)].na)); } + break; + + case 349: +/* Line 1807 of yacc.c */ +#line 2047 "fortran.y" + { optionaldeclare = 1 ; } + break; + + case 350: +/* Line 1807 of yacc.c */ +#line 2049 "fortran.y" + {VariableIsParameter = 1; } + break; + + case 351: +/* Line 1807 of yacc.c */ +#line 2051 "fortran.y" + { pointerdeclare = 1 ; } + break; + + case 352: +/* Line 1807 of yacc.c */ +#line 2053 "fortran.y" + { SaveDeclare = 1 ; } + break; + + case 353: +/* Line 1807 of yacc.c */ +#line 2055 "fortran.y" + { Targetdeclare = 1; } + break; + + case 354: +/* Line 1807 of yacc.c */ +#line 2060 "fortran.y" + {(yyval.l)=insertvar(NULL,(yyvsp[(1) - (1)].v));} + break; + + case 355: +/* Line 1807 of yacc.c */ +#line 2062 "fortran.y" + {(yyval.l)=insertvar((yyvsp[(1) - (3)].l),(yyvsp[(3) - (3)].v));} + break; + + case 356: +/* Line 1807 of yacc.c */ +#line 2067 "fortran.y" + { + if ( ! inside_type_declare ) + { + if (dimsgiven == 1) curvar = createvar((yyvsp[(1) - (4)].na),curdim); + else curvar = createvar((yyvsp[(1) - (4)].na),(yyvsp[(2) - (4)].d)); + CreateAndFillin_Curvar(DeclType, curvar); + strcpy(curvar->v_typevar,DeclType); + curvar->v_catvar = get_cat_var(curvar); + + if (!strcasecmp(DeclType,"character")) + { + if (c_selectorgiven == 1) + { + Save_Length(c_selectorname,1); + strcpy(curvar->v_dimchar,c_selectorname); + } + } + } + strcpy(vallengspec,""); + if (char_length_toreset == 1) + { + c_selectorgiven = 0; + c_star = 0; + strcpy(c_selectorname,""); + strcpy(CharacterSize,""); + char_length_toreset = 0; + } + (yyval.v)=curvar; + } + break; + + case 359: +/* Line 1807 of yacc.c */ +#line 2106 "fortran.y" + {InitialValueGiven = 0; } + break; + + case 361: +/* Line 1807 of yacc.c */ +#line 2112 "fortran.y" + { + if ( inside_type_declare ) break; + strcpy(InitValue,(yyvsp[(2) - (2)].na)); + InitialValueGiven = 1; + } + break; + + case 362: +/* Line 1807 of yacc.c */ +#line 2118 "fortran.y" + { + if ( inside_type_declare ) break; + strcpy(InitValue,(yyvsp[(2) - (2)].na)); + InitialValueGiven = 2; + } + break; + + case 363: +/* Line 1807 of yacc.c */ +#line 2124 "fortran.y" + { + if ( inside_type_declare ) break; + strcpy(InitValue,(yyvsp[(2) - (2)].na)); + InitialValueGiven = 2; + } + break; + + case 365: +/* Line 1807 of yacc.c */ +#line 2137 "fortran.y" + {PublicDeclare = 1; } + break; + + case 366: +/* Line 1807 of yacc.c */ +#line 2139 "fortran.y" + {PrivateDeclare = 1; } + break; + + case 367: +/* Line 1807 of yacc.c */ +#line 2143 "fortran.y" + {(yyval.d)=NULL;} + break; + + case 368: +/* Line 1807 of yacc.c */ +#line 2144 "fortran.y" + {in_complex_literal=0;} + break; + + case 369: +/* Line 1807 of yacc.c */ +#line 2145 "fortran.y" + {(yyval.d)=(yyvsp[(3) - (4)].d);} + break; + + case 370: +/* Line 1807 of yacc.c */ +#line 2150 "fortran.y" + {(yyval.d)=(yyvsp[(1) - (1)].d);} + break; + + case 371: +/* Line 1807 of yacc.c */ +#line 2152 "fortran.y" + {(yyval.d)=(yyvsp[(1) - (1)].d);} + break; + + case 372: +/* Line 1807 of yacc.c */ +#line 2154 "fortran.y" + {(yyval.d)=(yyvsp[(1) - (1)].d);} + break; + + case 373: +/* Line 1807 of yacc.c */ +#line 2156 "fortran.y" + {(yyval.d)=(yyvsp[(1) - (1)].d);} + break; + + case 374: +/* Line 1807 of yacc.c */ +#line 2158 "fortran.y" + {(yyval.d)=(yyvsp[(1) - (1)].d);} + break; + + case 375: +/* Line 1807 of yacc.c */ +#line 2162 "fortran.y" + { + (yyval.d) = (listdim*) NULL; + if ( inside_type_declare ) break; + if ( created_dimensionlist == 1 || agrif_parentcall == 1 ) (yyval.d)=insertdim(NULL,(yyvsp[(1) - (1)].dim1)); + } + break; + + case 376: +/* Line 1807 of yacc.c */ +#line 2168 "fortran.y" + { + (yyval.d) = (listdim*) NULL; + if ( inside_type_declare ) break; + if ( (!inside_type_declare) && created_dimensionlist == 1 ) (yyval.d)=insertdim((yyvsp[(1) - (3)].d),(yyvsp[(3) - (3)].dim1)); + } + break; + + case 377: +/* Line 1807 of yacc.c */ +#line 2177 "fortran.y" + {strcpy((yyval.dim1).first,(yyvsp[(1) - (3)].na)); Save_Length((yyvsp[(1) - (3)].na),2); strcpy((yyval.dim1).last,(yyvsp[(3) - (3)].na)); Save_Length((yyvsp[(3) - (3)].na),1); } + break; + + case 378: +/* Line 1807 of yacc.c */ +#line 2179 "fortran.y" + {strcpy((yyval.dim1).first,"1"); strcpy((yyval.dim1).last,(yyvsp[(1) - (1)].na)); Save_Length((yyvsp[(1) - (1)].na),1);} + break; + + case 379: +/* Line 1807 of yacc.c */ +#line 2184 "fortran.y" + {strcpy((yyval.na),(yyvsp[(1) - (1)].na));} + break; + + case 381: +/* Line 1807 of yacc.c */ +#line 2193 "fortran.y" + { + (yyval.d) = (listdim*) NULL; + if ( inside_type_declare ) break; + if ( created_dimensionlist == 1 || agrif_parentcall == 1 ) (yyval.d)=insertdim(NULL,(yyvsp[(1) - (1)].dim1)); + } + break; + + case 382: +/* Line 1807 of yacc.c */ +#line 2199 "fortran.y" + { + (yyval.d) = (listdim*) NULL; + if ( inside_type_declare ) break; + if ( (!inside_type_declare) && created_dimensionlist == 1 ) (yyval.d)=insertdim((yyvsp[(1) - (3)].d),(yyvsp[(3) - (3)].dim1)); + } + break; + + case 383: +/* Line 1807 of yacc.c */ +#line 2208 "fortran.y" + { strcpy((yyval.dim1).first,""); strcpy((yyval.dim1).last,""); } + break; + + case 384: +/* Line 1807 of yacc.c */ +#line 2210 "fortran.y" + { strcpy((yyval.dim1).first,(yyvsp[(1) - (2)].na)); Save_Length((yyvsp[(1) - (2)].na),2); strcpy((yyval.dim1).last,""); } + break; + + case 385: +/* Line 1807 of yacc.c */ +#line 2215 "fortran.y" + { + (yyval.d) = (listdim*) NULL; + if ( inside_type_declare ) break; + if ( created_dimensionlist == 1 || agrif_parentcall == 1 ) (yyval.d)=insertdim(NULL,(yyvsp[(1) - (1)].dim1)); + } + break; + + case 386: +/* Line 1807 of yacc.c */ +#line 2221 "fortran.y" + { + (yyval.d) = (listdim*) NULL; + if ( inside_type_declare ) break; + if ( (!inside_type_declare) && created_dimensionlist == 1 ) (yyval.d)=insertdim((yyvsp[(1) - (3)].d),(yyvsp[(3) - (3)].dim1)); + } + break; + + case 387: +/* Line 1807 of yacc.c */ +#line 2230 "fortran.y" + { strcpy((yyval.dim1).first,""); strcpy((yyval.dim1).last,""); } + break; + + case 388: +/* Line 1807 of yacc.c */ +#line 2235 "fortran.y" + { + (yyval.d) = (listdim*) NULL; + if ( inside_type_declare ) break; + if ( created_dimensionlist == 1 || agrif_parentcall == 1 ) + { + if (!strcasecmp((yyvsp[(2) - (3)].na),"")) + { + strcpy(my_dim.first,"1"); + } + else + { + strcpy(my_dim.first,(yyvsp[(2) - (3)].na)); + } + strcpy(my_dim.last,"*"); + (yyval.d)=insertdim((yyvsp[(1) - (3)].d),my_dim); + strcpy(my_dim.first,""); + strcpy(my_dim.last,""); + } + } + break; + + case 389: +/* Line 1807 of yacc.c */ +#line 2257 "fortran.y" + {(yyval.d) = (listdim *) NULL;} + break; + + case 390: +/* Line 1807 of yacc.c */ +#line 2259 "fortran.y" + {(yyval.d) = (yyvsp[(1) - (2)].d);} + break; + + case 391: +/* Line 1807 of yacc.c */ +#line 2277 "fortran.y" + {strcpy((yyval.na),"");} + break; + + case 392: +/* Line 1807 of yacc.c */ +#line 2279 "fortran.y" + {strcpy((yyval.na),(yyvsp[(1) - (2)].na));} + break; + + case 396: +/* Line 1807 of yacc.c */ +#line 2292 "fortran.y" + { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); } + break; + + case 397: +/* Line 1807 of yacc.c */ +#line 2294 "fortran.y" + { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); } + break; + + case 398: +/* Line 1807 of yacc.c */ +#line 2296 "fortran.y" + { strcpy((yyval.na),(yyvsp[(1) - (1)].na)); } + break; + + case 399: +/* Line 1807 of yacc.c */ +#line 2301 "fortran.y" + { + if ((firstpass == 0) && (PublicDeclare == 1)) + { + if ((yyvsp[(2) - (2)].lnn)) + { + removeglobfromlist(&((yyvsp[(2) - (2)].lnn))); + pos_end = setposcur(); + RemoveWordSET_0(fortran_out,pos_cur,pos_end-pos_cur); + writelistpublic((yyvsp[(2) - (2)].lnn)); + } + } + PublicDeclare = 0; + PrivateDeclare = 0; + } + break; + + case 401: +/* Line 1807 of yacc.c */ +#line 2319 "fortran.y" + {(yyval.lnn)=(listname *)NULL;} + break; + + case 402: +/* Line 1807 of yacc.c */ +#line 2321 "fortran.y" + {(yyval.lnn)=(yyvsp[(2) - (2)].lnn);} + break; + + case 403: +/* Line 1807 of yacc.c */ +#line 2325 "fortran.y" + {(yyval.lnn)=Insertname(NULL,(yyvsp[(1) - (1)].na),0);} + break; + + case 404: +/* Line 1807 of yacc.c */ +#line 2327 "fortran.y" + {(yyval.lnn)=Insertname((yyvsp[(1) - (3)].lnn),(yyvsp[(3) - (3)].na),0);} + break; + + case 407: +/* Line 1807 of yacc.c */ +#line 2337 "fortran.y" + { + /* we should remove the data declaration */ + pos_end = setposcur(); + RemoveWordSET_0(fortran_out,pos_curdata,pos_end-pos_curdata); + if ( aftercontainsdeclare == 1 && firstpass == 0 ) + { + ReWriteDataStatement_0(fortran_out); + pos_end = setposcur(); + } + Init_List_Data_Var(); + } + break; + + case 413: +/* Line 1807 of yacc.c */ +#line 2361 "fortran.y" + { + if (firstpass == 1) + { + Add_Data_Var_Names_01(&List_Data_Var,(yyvsp[(1) - (4)].l),(yyvsp[(3) - (4)].lnn)); + } + else Add_Data_Var_Names_01(&List_Data_Var_Cur,(yyvsp[(1) - (4)].l),(yyvsp[(3) - (4)].lnn)); + } + break; + + case 414: +/* Line 1807 of yacc.c */ +#line 2371 "fortran.y" + { (yyval.l)=insertvar(NULL,(yyvsp[(1) - (1)].v)); } + break; + + case 415: +/* Line 1807 of yacc.c */ +#line 2373 "fortran.y" + { + (yyval.l) = insertvar((yyvsp[(1) - (3)].l),(yyvsp[(3) - (3)].v)); + } + break; + + case 416: +/* Line 1807 of yacc.c */ +#line 2379 "fortran.y" + {(yyval.lnn)=Insertname(NULL,(yyvsp[(1) - (1)].na),0);} + break; + + case 417: +/* Line 1807 of yacc.c */ +#line 2381 "fortran.y" + {(yyval.lnn) = Insertname((yyvsp[(1) - (3)].lnn),(yyvsp[(3) - (3)].na),1); } + break; + + case 420: +/* Line 1807 of yacc.c */ +#line 2391 "fortran.y" + {printf("DOVARIABLE = %s %s %s\n",(yyvsp[(4) - (9)].na),(yyvsp[(6) - (9)].na),(yyvsp[(8) - (9)].na)); + printf("AUTRE = %s %s\n",(yyvsp[(2) - (9)].l)->var->v_nomvar,(yyvsp[(2) - (9)].l)->var->v_initialvalue_array); + Insertdoloop((yyvsp[(2) - (9)].l)->var,(yyvsp[(4) - (9)].na),(yyvsp[(6) - (9)].na),(yyvsp[(8) - (9)].na),""); + (yyval.v)=(yyvsp[(2) - (9)].l)->var; + } + break; + + case 421: +/* Line 1807 of yacc.c */ +#line 2397 "fortran.y" + { + Insertdoloop((yyvsp[(2) - (11)].l)->var,(yyvsp[(4) - (11)].na),(yyvsp[(6) - (11)].na),(yyvsp[(8) - (11)].na),(yyvsp[(10) - (11)].na)); + (yyval.v)=(yyvsp[(2) - (11)].l)->var; + } + break; + + case 422: +/* Line 1807 of yacc.c */ +#line 2404 "fortran.y" + {(yyval.l)=insertvar(NULL,(yyvsp[(1) - (1)].v));} + break; + + case 423: +/* Line 1807 of yacc.c */ +#line 2406 "fortran.y" + {(yyval.l) = insertvar((yyvsp[(1) - (3)].l),(yyvsp[(3) - (3)].v));} + break; + + case 425: +/* Line 1807 of yacc.c */ +#line 2412 "fortran.y" + {(yyval.v)->v_initialvalue_array=Insertname((yyval.v)->v_initialvalue_array,my_dim.last,0); + strcpy(my_dim.last,""); + } + break; + + case 428: +/* Line 1807 of yacc.c */ +#line 2425 "fortran.y" + {sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na));} + break; + + case 429: +/* Line 1807 of yacc.c */ +#line 2427 "fortran.y" + {sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na));} + break; + + case 430: +/* Line 1807 of yacc.c */ +#line 2429 "fortran.y" + {sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na));} + break; + + case 436: +/* Line 1807 of yacc.c */ +#line 2438 "fortran.y" + {strcpy((yyval.na),"");} + break; + + case 437: +/* Line 1807 of yacc.c */ +#line 2440 "fortran.y" + {sprintf((yyval.na),"*%s",(yyvsp[(2) - (2)].na));} + break; + + case 446: +/* Line 1807 of yacc.c */ +#line 2476 "fortran.y" + {strcpy(my_dim.last,"");} + break; + + case 447: +/* Line 1807 of yacc.c */ +#line 2480 "fortran.y" + {positioninblock = 0; pos_curdimension = my_position_before;} + break; + + case 448: +/* Line 1807 of yacc.c */ +#line 2482 "fortran.y" + { + /* if the variable is a parameter we can suppose that is */ + /* value is the same on each grid. It is not useless to */ + /* create a copy of it on each grid */ + if ( ! inside_type_declare ) + { + if ( firstpass ) + { + Add_Globliste_1((yyvsp[(4) - (4)].l)); + /* if variableparamlists has been declared in a subroutine */ + if ( insubroutinedeclare ) Add_Dimension_Var_1((yyvsp[(4) - (4)].l)); + + /* Add it to the List_SubroutineDeclaration_Var list if not present */ + /* NB: if not done, a variable declared with DIMENSION but with no type given */ + /* will not be declared by the conv */ + ReWriteDeclarationAndAddTosubroutine_01((yyvsp[(4) - (4)].l)); + } + else + { + pos_end = setposcur(); + RemoveWordSET_0(fortran_out,pos_curdimension,pos_end-pos_curdimension); + ReWriteDeclarationAndAddTosubroutine_01((yyvsp[(4) - (4)].l)); + } + } + PublicDeclare = 0; + PrivateDeclare = 0; + ExternalDeclare = 0; + strcpy(NamePrecision,""); + c_star = 0; + InitialValueGiven = 0 ; + strcpy(IntentSpec,""); + VariableIsParameter = 0 ; + Allocatabledeclare = 0 ; + Targetdeclare = 0 ; + SaveDeclare = 0; + pointerdeclare = 0; + optionaldeclare = 0 ; + dimsgiven=0; + c_selectorgiven=0; + strcpy(nameinttypename,""); + strcpy(c_selectorname,""); + } + break; + + case 450: +/* Line 1807 of yacc.c */ +#line 2527 "fortran.y" + {in_complex_literal = 0;} + break; + + case 451: +/* Line 1807 of yacc.c */ +#line 2528 "fortran.y" + { + if ( inside_type_declare ) break; + curvar = createvar((yyvsp[(1) - (5)].na),(yyvsp[(4) - (5)].d)); + CreateAndFillin_Curvar("", curvar); + curlistvar=insertvar(NULL, curvar); + (yyval.l) = settype("",curlistvar); + strcpy(vallengspec,""); + } + break; + + case 452: +/* Line 1807 of yacc.c */ +#line 2536 "fortran.y" + {in_complex_literal = 0;} + break; + + case 453: +/* Line 1807 of yacc.c */ +#line 2537 "fortran.y" + { + if ( inside_type_declare ) break; + curvar = createvar((yyvsp[(3) - (7)].na),(yyvsp[(6) - (7)].d)); + CreateAndFillin_Curvar("", curvar); + curlistvar = insertvar((yyvsp[(1) - (7)].l), curvar); + (yyval.l) = curlistvar; + strcpy(vallengspec,""); + } + break; + + case 454: +/* Line 1807 of yacc.c */ +#line 2549 "fortran.y" + { VariableIsParameter = 1; pos_curparameter = setposcur()-9; } + break; + + case 455: +/* Line 1807 of yacc.c */ +#line 2550 "fortran.y" + { + if ( ! inside_type_declare ) + { + if ( firstpass ) + { + if ( insubroutinedeclare ) Add_Parameter_Var_1((yyvsp[(4) - (5)].l)); + else Add_GlobalParameter_Var_1((yyvsp[(4) - (5)].l)); + } + else + { + pos_end = setposcur(); + RemoveWordSET_0(fortran_out, pos_curparameter, pos_end-pos_curparameter); + } + } + VariableIsParameter = 0 ; + } + break; + + case 457: +/* Line 1807 of yacc.c */ +#line 2570 "fortran.y" + {(yyval.l)=insertvar(NULL,(yyvsp[(1) - (1)].v));} + break; + + case 458: +/* Line 1807 of yacc.c */ +#line 2572 "fortran.y" + {(yyval.l)=insertvar((yyvsp[(1) - (3)].l),(yyvsp[(3) - (3)].v));} + break; + + case 459: +/* Line 1807 of yacc.c */ +#line 2577 "fortran.y" + { + if ( inside_type_declare ) break; + curvar=(variable *) calloc(1,sizeof(variable)); + Init_Variable(curvar); + curvar->v_VariableIsParameter = 1; + strcpy(curvar->v_nomvar,(yyvsp[(1) - (3)].na)); + strcpy(curvar->v_subroutinename,subroutinename); + strcpy(curvar->v_modulename,curmodulename); + curvar->v_initialvalue=Insertname(curvar->v_initialvalue,(yyvsp[(3) - (3)].na),0); + strcpy(curvar->v_commoninfile,cur_filename); + Save_Length((yyvsp[(3) - (3)].na),14); + (yyval.v) = curvar; + } + break; + + case 460: +/* Line 1807 of yacc.c */ +#line 2593 "fortran.y" + {pos_cursave = my_position_before;} + break; + + case 461: +/* Line 1807 of yacc.c */ +#line 2594 "fortran.y" + { + pos_end = setposcur(); + RemoveWordSET_0(fortran_out,pos_cursave,pos_end-pos_cursave); + } + break; + + case 469: +/* Line 1807 of yacc.c */ +#line 2615 "fortran.y" + {if ( ! inside_type_declare ) Add_Save_Var_1((yyvsp[(1) - (1)].na),(listdim*) NULL); } + break; + + case 473: +/* Line 1807 of yacc.c */ +#line 2625 "fortran.y" + {my_position = my_position_before;} + break; + + case 475: +/* Line 1807 of yacc.c */ +#line 2631 "fortran.y" + { + if ( insubroutinedeclare == 1 ) + { + Add_ImplicitNoneSubroutine_1(); + pos_end = setposcur(); + RemoveWordSET_0(fortran_out,my_position,pos_end-my_position); + } + } + break; + + case 493: +/* Line 1807 of yacc.c */ +#line 2683 "fortran.y" + {in_complex_literal=0;} + break; + + case 500: +/* Line 1807 of yacc.c */ +#line 2698 "fortran.y" + { positioninblock = 0; pos_curcommon = my_position_before; indeclaration=1;} + break; + + case 501: +/* Line 1807 of yacc.c */ +#line 2699 "fortran.y" + { + indeclaration = 0; + if ( inside_type_declare ) break; + pos_end = setposcur(); + RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon); + } + break; + + case 504: +/* Line 1807 of yacc.c */ +#line 2710 "fortran.y" + { + if ( inside_type_declare ) break; + sprintf(charusemodule,"%s",(yyvsp[(1) - (1)].na)); + Add_NameOfCommon_1((yyvsp[(1) - (1)].na),subroutinename); + } + break; + + case 505: +/* Line 1807 of yacc.c */ +#line 2718 "fortran.y" + { + strcpy((yyval.na),""); + positioninblock=0; + strcpy(commonblockname,""); + } + break; + + case 506: +/* Line 1807 of yacc.c */ +#line 2724 "fortran.y" + { + strcpy((yyval.na),(yyvsp[(2) - (3)].na)); + positioninblock=0; + strcpy(commonblockname,(yyvsp[(2) - (3)].na)); + } + break; + + case 510: +/* Line 1807 of yacc.c */ +#line 2737 "fortran.y" + { + if ( inside_type_declare ) break; + sprintf(charusemodule,"%s",(yyvsp[(3) - (3)].na)); + Add_NameOfCommon_1((yyvsp[(3) - (3)].na),subroutinename); + } + break; + + case 512: +/* Line 1807 of yacc.c */ +#line 2747 "fortran.y" + {if ( ! inside_type_declare ) Add_Common_var_1(); } + break; + + case 513: +/* Line 1807 of yacc.c */ +#line 2749 "fortran.y" + {if ( ! inside_type_declare ) Add_Common_var_1(); } + break; + + case 514: +/* Line 1807 of yacc.c */ +#line 2757 "fortran.y" + { + positioninblock = positioninblock + 1 ; + strcpy(commonvar,(yyvsp[(1) - (1)].na)); + commondim = (listdim*) NULL; + } + break; + + case 515: +/* Line 1807 of yacc.c */ +#line 2762 "fortran.y" + {in_complex_literal=0;} + break; + + case 516: +/* Line 1807 of yacc.c */ +#line 2763 "fortran.y" + { + positioninblock = positioninblock + 1 ; + strcpy(commonvar,(yyvsp[(1) - (5)].na)); + commondim = (yyvsp[(4) - (5)].d); + } + break; + + case 520: +/* Line 1807 of yacc.c */ +#line 2775 "fortran.y" + {(yyval.v)=createvar((yyvsp[(1) - (1)].na),NULL);} + break; + + case 522: +/* Line 1807 of yacc.c */ +#line 2787 "fortran.y" + {if (strcmp(my_dim.last,"")) + { + (yyval.v)->v_initialvalue_array=Insertname(NULL,my_dim.last,0); + } + strcpy(my_dim.last,""); + } + break; + + case 532: +/* Line 1807 of yacc.c */ +#line 2829 "fortran.y" + {sprintf((yyval.na),"%s(%s)",(yyvsp[(1) - (4)].na),(yyvsp[(3) - (4)].na));} + break; + + case 533: +/* Line 1807 of yacc.c */ +#line 2831 "fortran.y" + {sprintf((yyval.na),"%s(%s)",(yyvsp[(1) - (4)].na),(yyvsp[(3) - (4)].na));} + break; + + case 534: +/* Line 1807 of yacc.c */ +#line 2846 "fortran.y" + {sprintf((yyval.na),"%s:%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));} + break; + + case 535: +/* Line 1807 of yacc.c */ +#line 2851 "fortran.y" + {sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].v)->v_nomvar,(yyvsp[(2) - (2)].na));} + break; + + case 536: +/* Line 1807 of yacc.c */ +#line 2855 "fortran.y" + {strcpy((yyval.na),"");} + break; + + case 537: +/* Line 1807 of yacc.c */ +#line 2857 "fortran.y" + {sprintf((yyval.na),"%s%%%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].v)->v_nomvar);} + break; + + case 538: +/* Line 1807 of yacc.c */ +#line 2862 "fortran.y" + {(yyval.v)=createvar((yyvsp[(1) - (1)].na),NULL);} + break; + + case 539: +/* Line 1807 of yacc.c */ +#line 2863 "fortran.y" + {in_complex_literal=0;} + break; + + case 540: +/* Line 1807 of yacc.c */ +#line 2864 "fortran.y" + {sprintf(ligne,"%s(%s)",(yyvsp[(1) - (5)].na),(yyvsp[(4) - (5)].na));(yyval.v)=createvar((yyvsp[(1) - (5)].na),NULL);strcpy(my_dim.last,(yyvsp[(4) - (5)].na));} + break; + + case 542: +/* Line 1807 of yacc.c */ +#line 2880 "fortran.y" + {strcpy(my_dim.last,"");} + break; + + case 543: +/* Line 1807 of yacc.c */ +#line 2885 "fortran.y" + {strcpy(my_dim.last,"");} + break; + + case 544: +/* Line 1807 of yacc.c */ +#line 2890 "fortran.y" + {strcpy(my_dim.last,"");} + break; + + case 545: +/* Line 1807 of yacc.c */ +#line 2892 "fortran.y" + {strcpy(my_dim.last,"");} + break; + + case 546: +/* Line 1807 of yacc.c */ +#line 2898 "fortran.y" + {strcpy((yyval.na),"");} + break; + + case 547: +/* Line 1807 of yacc.c */ +#line 2900 "fortran.y" + {strcpy((yyval.na),(yyvsp[(1) - (1)].na));} + break; + + case 548: +/* Line 1807 of yacc.c */ +#line 2902 "fortran.y" + {sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));} + break; + + case 549: +/* Line 1807 of yacc.c */ +#line 2924 "fortran.y" + {sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na));} + break; + + case 550: +/* Line 1807 of yacc.c */ +#line 2926 "fortran.y" + {strcpy((yyval.na),":");} + break; + + case 551: +/* Line 1807 of yacc.c */ +#line 2928 "fortran.y" + {sprintf((yyval.na),":%s",(yyvsp[(2) - (2)].na));} + break; + + case 552: +/* Line 1807 of yacc.c */ +#line 2930 "fortran.y" + {sprintf((yyval.na),": :%s",(yyvsp[(3) - (3)].na));} + break; + + case 553: +/* Line 1807 of yacc.c */ +#line 2932 "fortran.y" + {sprintf((yyval.na),":%s :%s",(yyvsp[(2) - (4)].na),(yyvsp[(4) - (4)].na));} + break; + + case 554: +/* Line 1807 of yacc.c */ +#line 2934 "fortran.y" + {sprintf((yyval.na),"::%s",(yyvsp[(2) - (2)].na));} + break; + + case 556: +/* Line 1807 of yacc.c */ +#line 2937 "fortran.y" + {sprintf((yyval.na),"%s=%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));} + break; + + case 557: +/* Line 1807 of yacc.c */ +#line 2939 "fortran.y" + {sprintf((yyval.na),"%s=*%s",(yyvsp[(1) - (4)].na),(yyvsp[(4) - (4)].na));} + break; + + case 558: +/* Line 1807 of yacc.c */ +#line 2941 "fortran.y" + {sprintf((yyval.na),"*%s",(yyvsp[(2) - (2)].na));} + break; + + case 559: +/* Line 1807 of yacc.c */ +#line 2945 "fortran.y" + {strcpy((yyval.na),":");} + break; + + case 560: +/* Line 1807 of yacc.c */ +#line 2947 "fortran.y" + {sprintf((yyval.na),":%s",(yyvsp[(2) - (2)].na));} + break; + + case 561: +/* Line 1807 of yacc.c */ +#line 2949 "fortran.y" + {sprintf((yyval.na),": :%s",(yyvsp[(3) - (3)].na));} + break; + + case 562: +/* Line 1807 of yacc.c */ +#line 2951 "fortran.y" + {sprintf((yyval.na),":%s :%s",(yyvsp[(2) - (4)].na),(yyvsp[(4) - (4)].na));} + break; + + case 563: +/* Line 1807 of yacc.c */ +#line 2953 "fortran.y" + {sprintf((yyval.na),"::%s",(yyvsp[(2) - (2)].na));} + break; + + case 564: +/* Line 1807 of yacc.c */ +#line 2955 "fortran.y" + {strcpy((yyval.na),"");} + break; + + case 566: +/* Line 1807 of yacc.c */ +#line 2973 "fortran.y" + {in_complex_literal=0;} + break; + + case 567: +/* Line 1807 of yacc.c */ +#line 2974 "fortran.y" + {inallocate = 0;} + break; + + case 591: +/* Line 1807 of yacc.c */ +#line 3044 "fortran.y" + {in_complex_literal=0;} + break; + + case 592: +/* Line 1807 of yacc.c */ +#line 3045 "fortran.y" + {inallocate = 0;} + break; + + case 602: +/* Line 1807 of yacc.c */ +#line 3075 "fortran.y" + { + strcpy((yyval.na),(yyvsp[(1) - (1)].v)->v_nomvar); + if (strcasecmp(my_dim.last,"")) + { + strcat((yyval.na),"("); + strcat((yyval.na),my_dim.last); + strcat((yyval.na),")"); + } + } + break; + + case 606: +/* Line 1807 of yacc.c */ +#line 3088 "fortran.y" + { sprintf((yyval.na),"(%s)",(yyvsp[(2) - (3)].na));} + break; + + case 607: +/* Line 1807 of yacc.c */ +#line 3093 "fortran.y" + {strcpy(my_dim.last,"");} + break; + + case 609: +/* Line 1807 of yacc.c */ +#line 3099 "fortran.y" + {sprintf((yyval.na),"%s**%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));} + break; + + case 611: +/* Line 1807 of yacc.c */ +#line 3104 "fortran.y" + { sprintf((yyval.na),"%s%s%s",(yyvsp[(1) - (3)].na),(yyvsp[(2) - (3)].na),(yyvsp[(3) - (3)].na)); } + break; + + case 613: +/* Line 1807 of yacc.c */ +#line 3112 "fortran.y" + { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); } + break; + + case 614: +/* Line 1807 of yacc.c */ +#line 3114 "fortran.y" + { sprintf((yyval.na),"%s%s%s",(yyvsp[(1) - (3)].na),(yyvsp[(2) - (3)].na),(yyvsp[(3) - (3)].na)); } + break; + + case 616: +/* Line 1807 of yacc.c */ +#line 3117 "fortran.y" + { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); } + break; + + case 618: +/* Line 1807 of yacc.c */ +#line 3126 "fortran.y" + {strcpy((yyval.na),"*");} + break; + + case 620: +/* Line 1807 of yacc.c */ +#line 3132 "fortran.y" + {strcpy((yyval.na),"+");} + break; + + case 621: +/* Line 1807 of yacc.c */ +#line 3134 "fortran.y" + {strcpy((yyval.na),"-");} + break; + + case 623: +/* Line 1807 of yacc.c */ +#line 3140 "fortran.y" + { sprintf((yyval.na),"%s%s%s",(yyvsp[(1) - (3)].na),(yyvsp[(2) - (3)].na),(yyvsp[(3) - (3)].na)); } + break; + + case 626: +/* Line 1807 of yacc.c */ +#line 3149 "fortran.y" + { sprintf((yyval.na),"%s%s%s",(yyvsp[(1) - (3)].na),(yyvsp[(2) - (3)].na),(yyvsp[(3) - (3)].na)); } + break; + + case 635: +/* Line 1807 of yacc.c */ +#line 3162 "fortran.y" + {strcpy((yyval.na),"<");} + break; + + case 637: +/* Line 1807 of yacc.c */ +#line 3165 "fortran.y" + {strcpy((yyval.na),">");} + break; + + case 640: +/* Line 1807 of yacc.c */ +#line 3173 "fortran.y" + { sprintf((yyval.na),"%s%s",(yyvsp[(1) - (2)].na),(yyvsp[(2) - (2)].na)); } + break; + + case 642: +/* Line 1807 of yacc.c */ +#line 3180 "fortran.y" + { sprintf((yyval.na),"%s%s%s",(yyvsp[(1) - (3)].na),(yyvsp[(2) - (3)].na),(yyvsp[(3) - (3)].na)); } + break; + + case 644: +/* Line 1807 of yacc.c */ +#line 3187 "fortran.y" + { sprintf((yyval.na),"%s%s%s",(yyvsp[(1) - (3)].na),(yyvsp[(2) - (3)].na),(yyvsp[(3) - (3)].na)); } + break; + + case 646: +/* Line 1807 of yacc.c */ +#line 3193 "fortran.y" + { sprintf((yyval.na),"%s%s%s",(yyvsp[(1) - (3)].na),(yyvsp[(2) - (3)].na),(yyvsp[(3) - (3)].na)); } + break; + + case 656: +/* Line 1807 of yacc.c */ +#line 3229 "fortran.y" + {strcpy((yyval.na),"");} + break; + + case 659: +/* Line 1807 of yacc.c */ +#line 3238 "fortran.y" + { + strcpy((yyval.na),(yyvsp[(1) - (1)].na)); + } + break; + + case 660: +/* Line 1807 of yacc.c */ +#line 3245 "fortran.y" + {strcpy((yyval.na),(yyvsp[(1) - (1)].na));} + break; + + case 788: +/* Line 1807 of yacc.c */ +#line 3617 "fortran.y" + {in_select_case_stmt++;} + break; + + case 790: +/* Line 1807 of yacc.c */ +#line 3618 "fortran.y" + {in_select_case_stmt++;} + break; + + case 794: +/* Line 1807 of yacc.c */ +#line 3627 "fortran.y" + {in_select_case_stmt--;} + break; + + case 796: +/* Line 1807 of yacc.c */ +#line 3628 "fortran.y" + {in_select_case_stmt--;} + break; + + case 798: +/* Line 1807 of yacc.c */ +#line 3633 "fortran.y" + {in_complex_literal=0;} + break; + + case 822: +/* Line 1807 of yacc.c */ +#line 3696 "fortran.y" + {close_or_connect = 1;} + break; + + case 823: +/* Line 1807 of yacc.c */ +#line 3696 "fortran.y" + {close_or_connect = 0;} + break; + + case 840: +/* Line 1807 of yacc.c */ +#line 3726 "fortran.y" + {close_or_connect = 1;} + break; + + case 841: +/* Line 1807 of yacc.c */ +#line 3727 "fortran.y" + {close_or_connect = 0;} + break; + + case 849: +/* Line 1807 of yacc.c */ +#line 3744 "fortran.y" + { + in_io_control_spec = 0; + } + break; + + case 851: +/* Line 1807 of yacc.c */ +#line 3749 "fortran.y" + { + in_io_control_spec = 0; + } + break; + + case 855: +/* Line 1807 of yacc.c */ +#line 3759 "fortran.y" + { + in_io_control_spec = 0; + } + break; + + case 857: +/* Line 1807 of yacc.c */ +#line 3764 "fortran.y" + { + in_io_control_spec = 0; + } + break; + + case 911: +/* Line 1807 of yacc.c */ +#line 3876 "fortran.y" + {in_inquire=0;} + break; + + case 913: +/* Line 1807 of yacc.c */ +#line 3879 "fortran.y" + {in_inquire=0;} + break; + + case 915: +/* Line 1807 of yacc.c */ +#line 3883 "fortran.y" + {in_inquire=1;} + break; + + case 930: +/* Line 1807 of yacc.c */ +#line 3910 "fortran.y" + {pos_endsubroutine=setposcur();} + break; + + case 934: +/* Line 1807 of yacc.c */ +#line 3919 "fortran.y" + { + GlobalDeclaration = 0; + strcpy(curmodulename,(yyvsp[(2) - (2)].na)); + strcpy(subroutinename,""); + Add_NameOfModule_1((yyvsp[(2) - (2)].na)); + if ( inmoduledeclare == 0 ) + { + /* To know if there are in the module declaration */ + inmoduledeclare = 1; + /* to know if a module has been met */ + inmodulemeet = 1; + /* to know if we are after the keyword contains */ + aftercontainsdeclare = 0 ; + } + } + break; + + case 936: +/* Line 1807 of yacc.c */ +#line 3939 "fortran.y" + { + /* if we never meet the contains keyword */ + if ( firstpass == 0 ) + { + RemoveWordCUR_0(fortran_out, setposcur()-my_position); // Remove word "end module" + if ( inmoduledeclare && ! aftercontainsdeclare ) + { + Write_Closing_Module(1); + } + fprintf(fortran_out,"\n end module %s\n", curmodulename); + if ( module_declar && insubroutinedeclare == 0 ) + { + fclose(module_declar); + } + } + inmoduledeclare = 0 ; + inmodulemeet = 0 ; + aftercontainsdeclare = 1; + strcpy(curmodulename, ""); + GlobalDeclaration = 0 ; + } + break; + + case 951: +/* Line 1807 of yacc.c */ +#line 3991 "fortran.y" + {if (firstpass == 0 && oldfortran_out) pos_curuseold = setposcurname(oldfortran_out);} + break; + + case 952: +/* Line 1807 of yacc.c */ +#line 3996 "fortran.y" + { + if ( firstpass ) + { + if ( insubroutinedeclare ) + { + if ((yyvsp[(6) - (6)].lc)) { + Add_CouplePointed_Var_1((yyvsp[(5) - (6)].na),(yyvsp[(6) - (6)].lc)); + coupletmp = (yyvsp[(6) - (6)].lc); + strcpy(ligne,""); + while ( coupletmp ) + { + strcat(ligne, coupletmp->c_namevar); + strcat(ligne, " => "); + strcat(ligne, coupletmp->c_namepointedvar); + coupletmp = coupletmp->suiv; + if ( coupletmp ) strcat(ligne,","); + } + } + sprintf(charusemodule,"%s",(yyvsp[(5) - (6)].na)); + } + Add_NameOfModuleUsed_1((yyvsp[(5) - (6)].na)); + } + else + { + if ( insubroutinedeclare ) + { + copyuse_0((yyvsp[(5) - (6)].na)); + } + + if ( inmoduledeclare == 0 ) + { + pos_end = setposcur(); + RemoveWordSET_0(fortran_out,my_position,pos_end-my_position); + } + } + } + break; + + case 954: +/* Line 1807 of yacc.c */ +#line 4034 "fortran.y" + { + if ( firstpass ) + { + if ( insubroutinedeclare ) + { + if ((yyvsp[(9) - (9)].lc)) + { + Add_CouplePointed_Var_1((yyvsp[(5) - (9)].na),(yyvsp[(9) - (9)].lc)); + coupletmp = (yyvsp[(9) - (9)].lc); + strcpy(ligne,""); + while ( coupletmp ) + { + strcat(ligne,coupletmp->c_namevar); + if ( strcasecmp(coupletmp->c_namepointedvar,"") ) strcat(ligne," => "); + strcat(ligne,coupletmp->c_namepointedvar); + coupletmp = coupletmp->suiv; + if ( coupletmp ) strcat(ligne,","); + } + } + sprintf(charusemodule,"%s",(yyvsp[(5) - (9)].na)); + } + Add_NameOfModuleUsed_1((yyvsp[(5) - (9)].na)); + } + else + { + if ( insubroutinedeclare ) + copyuseonly_0((yyvsp[(5) - (9)].na)); + + if ( inmoduledeclare == 0 ) + { + pos_end = setposcur(); + RemoveWordSET_0(fortran_out,my_position,pos_end-my_position); + if ((yyvsp[(9) - (9)].lc)) + { + if (oldfortran_out) variableisglobalinmodule((yyvsp[(9) - (9)].lc),(yyvsp[(5) - (9)].na),oldfortran_out,pos_curuseold); + } + } + else + { + if ((yyvsp[(9) - (9)].lc)) + { + /* if we are in the module declare and if the */ + /* onlylist is a list of global variable */ + variableisglobalinmodule((yyvsp[(9) - (9)].lc), (yyvsp[(5) - (9)].na), fortran_out,my_position); + } + } + } + } + break; + + case 959: +/* Line 1807 of yacc.c */ +#line 4091 "fortran.y" + {(yyval.lc)=NULL;} + break; + + case 960: +/* Line 1807 of yacc.c */ +#line 4093 "fortran.y" + {(yyval.lc)=(yyvsp[(1) - (1)].lc);} + break; + + case 966: +/* Line 1807 of yacc.c */ +#line 4110 "fortran.y" + { + strcpy(subroutinename,(yyvsp[(2) - (2)].na)); + insubroutinedeclare = 1; + inprogramdeclare = 1; + /* in the second step we should write the head of */ + /* the subroutine sub_loop_ */ + if ( ! firstpass ) + WriteBeginof_SubLoop(); + } + break; + + case 968: +/* Line 1807 of yacc.c */ +#line 4123 "fortran.y" + {pos_endsubroutine=my_position_before;} + break; + + case 969: +/* Line 1807 of yacc.c */ +#line 4124 "fortran.y" + { + insubroutinedeclare = 0; + inprogramdeclare = 0; + pos_cur = setposcur(); + closeandcallsubloopandincludeit_0(3); + functiondeclarationisdone = 0; + strcpy(subroutinename,""); + } + break; + + case 976: +/* Line 1807 of yacc.c */ +#line 4146 "fortran.y" + { + (yyval.lc)=NULL; + } + break; + + case 977: +/* Line 1807 of yacc.c */ +#line 4150 "fortran.y" + { + (yyval.lc)=(yyvsp[(2) - (2)].lc); + } + break; + + case 978: +/* Line 1807 of yacc.c */ +#line 4156 "fortran.y" + { + (yyval.lc)=(yyvsp[(1) - (1)].lc); + } + break; + + case 979: +/* Line 1807 of yacc.c */ +#line 4160 "fortran.y" + { + /* insert the variable in the list $1 */ + (yyvsp[(3) - (3)].lc)->suiv = (yyvsp[(1) - (3)].lc); + (yyval.lc)=(yyvsp[(3) - (3)].lc); + } + break; + + case 980: +/* Line 1807 of yacc.c */ +#line 4169 "fortran.y" + { + coupletmp = (listcouple *) calloc(1,sizeof(listcouple)); + strcpy(coupletmp->c_namevar,(yyvsp[(1) - (3)].na)); + strcpy(coupletmp->c_namepointedvar,(yyvsp[(3) - (3)].na)); + coupletmp->suiv = NULL; + (yyval.lc) = coupletmp; + } + break; + + case 981: +/* Line 1807 of yacc.c */ +#line 4179 "fortran.y" + {(yyval.lc)=(yyvsp[(1) - (1)].lc);} + break; + + case 982: +/* Line 1807 of yacc.c */ +#line 4181 "fortran.y" + { + /* insert the variable in the list $1 */ + (yyvsp[(3) - (3)].lc)->suiv = (yyvsp[(1) - (3)].lc); + (yyval.lc) = (yyvsp[(3) - (3)].lc); + } + break; + + case 983: +/* Line 1807 of yacc.c */ +#line 4190 "fortran.y" + { + coupletmp = (listcouple *)calloc(1,sizeof(listcouple)); + strcpy(coupletmp->c_namevar,(yyvsp[(1) - (1)].na)); + strcpy(coupletmp->c_namepointedvar,""); + coupletmp->suiv = NULL; + (yyval.lc) = coupletmp; + } + break; + + case 984: +/* Line 1807 of yacc.c */ +#line 4198 "fortran.y" + { + coupletmp = (listcouple *)calloc(1,sizeof(listcouple)); + strcpy(coupletmp->c_namevar,(yyvsp[(1) - (1)].na)); + strcpy(coupletmp->c_namepointedvar,""); + coupletmp->suiv = NULL; + (yyval.lc) = coupletmp; + } + break; + + case 985: +/* Line 1807 of yacc.c */ +#line 4206 "fortran.y" + { + (yyval.lc)=(yyvsp[(1) - (1)].lc); + pointedvar = 1; + Add_UsedInSubroutine_Var_1((yyvsp[(1) - (1)].lc)->c_namevar); + } + break; + + case 998: +/* Line 1807 of yacc.c */ +#line 4246 "fortran.y" + {in_complex_literal=0;} + break; + + case 999: +/* Line 1807 of yacc.c */ +#line 4247 "fortran.y" + {sprintf((yyval.na),"%s(%s)",(yyvsp[(1) - (5)].na),(yyvsp[(4) - (5)].na));} + break; + + case 1000: +/* Line 1807 of yacc.c */ +#line 4253 "fortran.y" + { + inagrifcallargument = 0 ; + incalldeclare=0; + if ( oldfortran_out && (callagrifinitgrids == 1) && (firstpass == 0) ) + { + pos_end = setposcur(); + RemoveWordSET_0(fortran_out,pos_curcall,pos_end-pos_curcall); + strcpy(subofagrifinitgrids,subroutinename); + } + Instanciation_0(sameagrifname); + } + break; + + case 1002: +/* Line 1807 of yacc.c */ +#line 4266 "fortran.y" + { + inagrifcallargument = 0 ; + incalldeclare=0; + if ( oldfortran_out && (callagrifinitgrids == 1) && (firstpass == 0) ) + { + pos_end = setposcur(); + RemoveWordSET_0(fortran_out,pos_curcall,pos_end-pos_curcall); + strcpy(subofagrifinitgrids,subroutinename); + } + Instanciation_0(sameagrifname); + } + break; + + case 1004: +/* Line 1807 of yacc.c */ +#line 4278 "fortran.y" + {in_complex_literal=0;} + break; + + case 1005: +/* Line 1807 of yacc.c */ +#line 4279 "fortran.y" + { + inagrifcallargument = 0 ; + incalldeclare=0; + if ( oldfortran_out && (callagrifinitgrids == 1) && (firstpass == 0) ) + { + pos_end = setposcur(); + RemoveWordSET_0(fortran_out,pos_curcall,pos_end-pos_curcall); + strcpy(subofagrifinitgrids,subroutinename); + } + Instanciation_0(sameagrifname); + } + break; + + case 1007: +/* Line 1807 of yacc.c */ +#line 4293 "fortran.y" + {pos_curcall=my_position_before-strlen((yyvsp[(1) - (2)].na))-4;} + break; + + case 1008: +/* Line 1807 of yacc.c */ +#line 4294 "fortran.y" + { + if (!strcasecmp((yyvsp[(4) - (4)].na),"MPI_Init") ) callmpiinit = 1; + else callmpiinit = 0; + + if (!strcasecmp((yyvsp[(4) - (4)].na),"Agrif_Init_Grids") ) + { + callagrifinitgrids = 1; + strcpy(meetagrifinitgrids,subroutinename); + } + else + { + callagrifinitgrids = 0; + } + if ( Vartonumber((yyvsp[(4) - (4)].na)) == 1 ) + { + incalldeclare = 0; + inagrifcallargument = 0 ; + Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename); + } + } + break; + + case 1013: +/* Line 1807 of yacc.c */ +#line 4325 "fortran.y" + {sprintf((yyval.na),"%s,%s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na));} + break; + + case 1014: +/* Line 1807 of yacc.c */ +#line 4330 "fortran.y" + { + if ( callmpiinit == 1 ) + { + strcpy(mpiinitvar,(yyvsp[(1) - (1)].na)); + if ( firstpass == 1 ) Add_UsedInSubroutine_Var_1 (mpiinitvar); + } + } + break; + + case 1015: +/* Line 1807 of yacc.c */ +#line 4338 "fortran.y" + {sprintf((yyval.na),"%s = %s",(yyvsp[(1) - (3)].na),(yyvsp[(3) - (3)].na)); + if ( callmpiinit == 1 ) + { + strcpy(mpiinitvar,(yyvsp[(3) - (3)].na)); + if ( firstpass == 1 ) Add_UsedInSubroutine_Var_1 (mpiinitvar); + } + } + break; + + case 1017: +/* Line 1807 of yacc.c */ +#line 4350 "fortran.y" + { + strcpy((yyval.na),(yyvsp[(1) - (1)].v)->v_nomvar); + if ((yyvsp[(1) - (1)].v)->v_initialvalue_array) + { + strcat((yyval.na),"("); + strcat((yyval.na),(yyvsp[(1) - (1)].v)->v_initialvalue_array->n_name); + strcat((yyval.na),")"); + } + } + break; + + case 1019: +/* Line 1807 of yacc.c */ +#line 4362 "fortran.y" + {isrecursive = 0;} + break; + + case 1023: +/* Line 1807 of yacc.c */ +#line 4373 "fortran.y" + {isrecursive = 0; functiondeclarationisdone = 1;} + break; + + case 1024: +/* Line 1807 of yacc.c */ +#line 4375 "fortran.y" + {isrecursive = 0;} + break; + + case 1025: +/* Line 1807 of yacc.c */ +#line 4377 "fortran.y" + {isrecursive = 1;} + break; + + case 1027: +/* Line 1807 of yacc.c */ +#line 4386 "fortran.y" + {in_complex_literal=0;} + break; + + case 1028: +/* Line 1807 of yacc.c */ +#line 4387 "fortran.y" + { + insubroutinedeclare = 1; + suborfun = 0; + /* we should to list of the subroutine argument the */ + /* name of the function which has to be defined */ + if ( firstpass ) + { + Add_SubroutineArgument_Var_1((yyvsp[(6) - (8)].l)); + if ( ! is_result_present ) + Add_FunctionType_Var_1((yyvsp[(3) - (8)].na)); + } + else + /* in the second step we should write the head of */ + /* the subroutine sub_loop_ */ + { + if (todebug == 1) fprintf(fortran_out," !DEBUG: Avant Writebeginof subloop\n"); + WriteBeginof_SubLoop(); + if (todebug == 1) fprintf(fortran_out," !DEBUG: Apres Writebeginof subloop\n"); + } + strcpy(NamePrecision,""); + } + break; + + case 1030: +/* Line 1807 of yacc.c */ +#line 4412 "fortran.y" + { + if (strcmp(subroutinename,"")) + { + strcpy(old_subroutinename,subroutinename); // can occur in internal-subprogram + old_oldfortran_out=oldfortran_out; + } + else + { + old_oldfortran_out=(FILE *)NULL; + } + strcpy((yyval.na),(yyvsp[(1) - (1)].na));strcpy(subroutinename,(yyvsp[(1) - (1)].na)); + } + break; + + case 1031: +/* Line 1807 of yacc.c */ +#line 4437 "fortran.y" + {strcpy((yyval.na),(yyvsp[(1) - (1)].na));} + break; + + case 1032: +/* Line 1807 of yacc.c */ +#line 4441 "fortran.y" + {is_result_present = 0; } + break; + + case 1034: +/* Line 1807 of yacc.c */ +#line 4447 "fortran.y" + {is_result_present = 1; + if ( firstpass == 1 ) + { + strcpy(nameinttypenameback,nameinttypename); + strcpy(nameinttypename,""); + curvar = createvar((yyvsp[(3) - (4)].na),NULL); + strcpy(nameinttypename,nameinttypenameback); + strcpy(curvar->v_typevar,""); + curlistvar = insertvar(NULL,curvar); + Add_SubroutineArgument_Var_1(curlistvar); + } + } + break; + + case 1035: +/* Line 1807 of yacc.c */ +#line 4463 "fortran.y" + {strcpy(DeclType, "");} + break; + + case 1040: +/* Line 1807 of yacc.c */ +#line 4477 "fortran.y" + { + insubroutinedeclare = 1; + suborfun = 1; + if ( firstpass ) + Add_SubroutineArgument_Var_1((yyvsp[(4) - (4)].l)); + else + { + WriteBeginof_SubLoop(); + } + } + break; + + case 1042: +/* Line 1807 of yacc.c */ +#line 4492 "fortran.y" + { + if (strcmp(subroutinename,"")) + { + strcpy(old_subroutinename,subroutinename); // can occur in internal-subprogram + old_oldfortran_out=oldfortran_out; + } + else + { + old_oldfortran_out=(FILE *)NULL; + } + strcpy((yyval.na),(yyvsp[(1) - (1)].na));strcpy(subroutinename,(yyvsp[(1) - (1)].na)); + } + break; + + case 1044: +/* Line 1807 of yacc.c */ +#line 4513 "fortran.y" + {pos_endsubroutine = my_position; + GlobalDeclaration = 0 ; + if ( firstpass == 0 && strcasecmp(subroutinename,"") ) + { + if ( module_declar && insubroutinedeclare == 0 ) fclose(module_declar); + } + if ( strcasecmp(subroutinename,"") ) + { + if ( inmodulemeet == 1 ) + { + /* we are in a module */ + if ( insubroutinedeclare == 1 ) + { + /* it is like an end subroutine */ + insubroutinedeclare = 0 ; + pos_cur = setposcur(); + closeandcallsubloopandincludeit_0(suborfun); + functiondeclarationisdone = 0; + } + else + { + /* it is like an end module */ + inmoduledeclare = 0 ; + inmodulemeet = 0 ; + } + } + else + { + insubroutinedeclare = 0; + pos_cur = setposcur(); + closeandcallsubloopandincludeit_0(2); + functiondeclarationisdone = 0; + } + } + strcpy(subroutinename,""); + if (strcmp(old_subroutinename,"")) + { + strcpy(subroutinename,old_subroutinename); + strcpy(old_subroutinename,""); + oldfortran_out=old_oldfortran_out; + insubroutinedeclare=1; + } + } + break; + + case 1047: +/* Line 1807 of yacc.c */ +#line 4562 "fortran.y" + {if (firstpass) (yyval.l)=NULL;} + break; + + case 1048: +/* Line 1807 of yacc.c */ +#line 4563 "fortran.y" + {in_complex_literal=0;} + break; + + case 1049: +/* Line 1807 of yacc.c */ +#line 4564 "fortran.y" + {if (firstpass) (yyval.l)=(yyvsp[(3) - (4)].l);} + break; + + case 1050: +/* Line 1807 of yacc.c */ +#line 4568 "fortran.y" + {if (firstpass) (yyval.l)=NULL;} + break; + + case 1051: +/* Line 1807 of yacc.c */ +#line 4570 "fortran.y" + {if (firstpass) (yyval.l)=(yyvsp[(1) - (1)].l);} + break; + + case 1052: +/* Line 1807 of yacc.c */ +#line 4575 "fortran.y" + { + if ( firstpass == 1 ) + { + strcpy(nameinttypenameback,nameinttypename); + strcpy(nameinttypename,""); + curvar = createvar((yyvsp[(1) - (1)].na),NULL); + strcpy(nameinttypename,nameinttypenameback); + curlistvar = insertvar(NULL,curvar); + (yyval.l) = settype("",curlistvar); + } + } + break; + + case 1053: +/* Line 1807 of yacc.c */ +#line 4587 "fortran.y" + { + if ( firstpass == 1 ) + { + strcpy(nameinttypenameback,nameinttypename); + strcpy(nameinttypename,""); + curvar = createvar((yyvsp[(3) - (3)].na),NULL); + strcpy(nameinttypename,nameinttypenameback); + (yyval.l) = insertvar((yyvsp[(1) - (3)].l),curvar); + } + } + break; + + case 1054: +/* Line 1807 of yacc.c */ +#line 4601 "fortran.y" + {strcpy((yyval.na),(yyvsp[(1) - (1)].na));} + break; + + case 1055: +/* Line 1807 of yacc.c */ +#line 4603 "fortran.y" + {strcpy((yyval.na),"*");} + break; + + case 1058: +/* Line 1807 of yacc.c */ +#line 4613 "fortran.y" + { + if ( inside_type_declare ) break; + if ( inmoduledeclare ) + { + if ( firstpass == 0 ) + { + RemoveWordCUR_0(fortran_out,9); // Remove word 'contains' + Write_Closing_Module(0); + } + inmoduledeclare = 0 ; + aftercontainsdeclare = 1; + } + else if ( insubroutinedeclare ) + { + incontainssubroutine = 1; + insubroutinedeclare = 0; + incontainssubroutine = 0; + functiondeclarationisdone = 0; + + if ( firstpass ) + List_ContainsSubroutine = Addtolistnom(subroutinename, List_ContainsSubroutine, 0); + else + closeandcallsubloop_contains_0(); + + strcpy(subroutinename, ""); + } + else printf("l.%4d -- TOK_CONTAINS -- MHCHECK\n",line_num_input); + } + break; + + case 1060: +/* Line 1807 of yacc.c */ +#line 4648 "fortran.y" + {strcpy((yyval.na),"");} + break; + + case 1061: +/* Line 1807 of yacc.c */ +#line 4649 "fortran.y" + {strcpy((yyval.na),(yyvsp[(1) - (1)].na));} + break; + + case 1067: +/* Line 1807 of yacc.c */ +#line 4777 "fortran.y" + { afterpercent = 1; } + break; + + +/* Line 1807 of yacc.c */ +#line 7054 "fortran.tab.c" + default: break; + } + /* User semantic actions sometimes alter yychar, and that requires + that yytoken be updated with the new translation. We take the + approach of translating immediately before every use of yytoken. + One alternative is translating here after every semantic action, + but that translation would be missed if the semantic action invokes + YYABORT, YYACCEPT, or YYERROR immediately after altering yychar or + if it invokes YYBACKUP. In the case of YYABORT or YYACCEPT, an + incorrect destructor might then be invoked immediately. In the + case of YYERROR or YYBACKUP, subsequent parser actions might lead + to an incorrect destructor call or verbose syntax error message + before the lookahead is translated. */ + YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc); + + YYPOPSTACK (yylen); + yylen = 0; + YY_STACK_PRINT (yyss, yyssp); + + *++yyvsp = yyval; + + /* Now `shift' the result of the reduction. Determine what state + that goes to, based on the state we popped back to and the rule + number reduced by. */ + + yyn = yyr1[yyn]; + + yystate = yypgoto[yyn - YYNTOKENS] + *yyssp; + if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp) + yystate = yytable[yystate]; + else + yystate = yydefgoto[yyn - YYNTOKENS]; + + goto yynewstate; + + +/*------------------------------------. +| yyerrlab -- here on detecting error | +`------------------------------------*/ +yyerrlab: + /* Make sure we have latest lookahead translation. See comments at + user semantic actions for why this is necessary. */ + yytoken = yychar == YYEMPTY ? YYEMPTY : YYTRANSLATE (yychar); + + /* If not already recovering from an error, report this error. */ + if (!yyerrstatus) + { + ++yynerrs; +#if ! YYERROR_VERBOSE + yyerror (YY_("syntax error")); +#else +# define YYSYNTAX_ERROR yysyntax_error (&yymsg_alloc, &yymsg, \ + yyssp, yytoken) + { + char const *yymsgp = YY_("syntax error"); + int yysyntax_error_status; + yysyntax_error_status = YYSYNTAX_ERROR; + if (yysyntax_error_status == 0) + yymsgp = yymsg; + else if (yysyntax_error_status == 1) + { + if (yymsg != yymsgbuf) + YYSTACK_FREE (yymsg); + yymsg = (char *) YYSTACK_ALLOC (yymsg_alloc); + if (!yymsg) + { + yymsg = yymsgbuf; + yymsg_alloc = sizeof yymsgbuf; + yysyntax_error_status = 2; + } + else + { + yysyntax_error_status = YYSYNTAX_ERROR; + yymsgp = yymsg; + } + } + yyerror (yymsgp); + if (yysyntax_error_status == 2) + goto yyexhaustedlab; + } +# undef YYSYNTAX_ERROR +#endif + } + + + + if (yyerrstatus == 3) + { + /* If just tried and failed to reuse lookahead token after an + error, discard it. */ + + if (yychar <= YYEOF) + { + /* Return failure if at end of input. */ + if (yychar == YYEOF) + YYABORT; + } + else + { + yydestruct ("Error: discarding", + yytoken, &yylval); + yychar = YYEMPTY; + } + } + + /* Else will try to reuse lookahead token after shifting the error + token. */ + goto yyerrlab1; + + +/*---------------------------------------------------. +| yyerrorlab -- error raised explicitly by YYERROR. | +`---------------------------------------------------*/ +yyerrorlab: + + /* Pacify compilers like GCC when the user code never invokes + YYERROR and the label yyerrorlab therefore never appears in user + code. */ + if (/*CONSTCOND*/ 0) + goto yyerrorlab; + + /* Do not reclaim the symbols of the rule which action triggered + this YYERROR. */ + YYPOPSTACK (yylen); + yylen = 0; + YY_STACK_PRINT (yyss, yyssp); + yystate = *yyssp; + goto yyerrlab1; + + +/*-------------------------------------------------------------. +| yyerrlab1 -- common code for both syntax error and YYERROR. | +`-------------------------------------------------------------*/ +yyerrlab1: + yyerrstatus = 3; /* Each real token shifted decrements this. */ + + for (;;) + { + yyn = yypact[yystate]; + if (!yypact_value_is_default (yyn)) + { + yyn += YYTERROR; + if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) + { + yyn = yytable[yyn]; + if (0 < yyn) + break; + } + } + + /* Pop the current state because it cannot handle the error token. */ + if (yyssp == yyss) + YYABORT; + + + yydestruct ("Error: popping", + yystos[yystate], yyvsp); + YYPOPSTACK (1); + yystate = *yyssp; + YY_STACK_PRINT (yyss, yyssp); + } + + YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN + *++yyvsp = yylval; + YY_IGNORE_MAYBE_UNINITIALIZED_END + + + /* Shift the error token. */ + YY_SYMBOL_PRINT ("Shifting", yystos[yyn], yyvsp, yylsp); + + yystate = yyn; + goto yynewstate; + + +/*-------------------------------------. +| yyacceptlab -- YYACCEPT comes here. | +`-------------------------------------*/ +yyacceptlab: + yyresult = 0; + goto yyreturn; + +/*-----------------------------------. +| yyabortlab -- YYABORT comes here. | +`-----------------------------------*/ +yyabortlab: + yyresult = 1; + goto yyreturn; + +#if !defined yyoverflow || YYERROR_VERBOSE +/*-------------------------------------------------. +| yyexhaustedlab -- memory exhaustion comes here. | +`-------------------------------------------------*/ +yyexhaustedlab: + yyerror (YY_("memory exhausted")); + yyresult = 2; + /* Fall through. */ +#endif + +yyreturn: + if (yychar != YYEMPTY) + { + /* Make sure we have latest lookahead translation. See comments at + user semantic actions for why this is necessary. */ + yytoken = YYTRANSLATE (yychar); + yydestruct ("Cleanup: discarding lookahead", + yytoken, &yylval); + } + /* Do not reclaim the symbols of the rule which action triggered + this YYABORT or YYACCEPT. */ + YYPOPSTACK (yylen); + YY_STACK_PRINT (yyss, yyssp); + while (yyssp != yyss) + { + yydestruct ("Cleanup: popping", + yystos[*yyssp], yyvsp); + YYPOPSTACK (1); + } +#ifndef yyoverflow + if (yyss != yyssa) + YYSTACK_FREE (yyss); +#endif +#if YYERROR_VERBOSE + if (yymsg != yymsgbuf) + YYSTACK_FREE (yymsg); +#endif + /* Make sure YYID is used. */ + return YYID (yyresult); +} + + +/* Line 2055 of yacc.c */ +#line 4874 "fortran.y" + + +void process_fortran(const char *input_file) +{ + extern FILE *fortran_in; + extern FILE *fortran_out; + + char output_file[LONG_FNAME]; + char input_fullpath[LONG_FNAME]; + + if ( todebug == 1 ) printf("Firstpass == %d \n", firstpass); + + yydebug=0; +/******************************************************************************/ +/* 1- Open input file */ +/******************************************************************************/ + + strcpy(cur_filename, input_file); + sprintf(input_fullpath, "%s/%s", input_dir, input_file); + + fortran_in = fopen(input_fullpath, "r"); + if (! fortran_in) + { + printf("Error : File %s does not exist\n", input_fullpath); + exit(1); + } + +/******************************************************************************/ +/* 2- Variables initialization */ +/******************************************************************************/ + + line_num_input = 1; + PublicDeclare = 0; + PrivateDeclare = 0; + ExternalDeclare = 0; + SaveDeclare = 0; + pointerdeclare = 0; + optionaldeclare = 0; + incalldeclare = 0; + inside_type_declare = 0; + Allocatabledeclare = 0 ; + Targetdeclare = 0 ; + VariableIsParameter = 0 ; + strcpy(NamePrecision,""); + c_star = 0 ; + functiondeclarationisdone = 0; + insubroutinedeclare = 0 ; + strcpy(subroutinename," "); + isrecursive = 0; + InitialValueGiven = 0 ; + GlobalDeclarationType = 0; + inmoduledeclare = 0; + incontainssubroutine = 0; + afterpercent = 0; + aftercontainsdeclare = 1; + strcpy(nameinttypename,""); + +/******************************************************************************/ +/* 3- Parsing of the input file (1 time) */ +/******************************************************************************/ + + sprintf(output_file, "%s/%s", output_dir, input_file); + + if (firstpass == 0) fortran_out = fopen(output_file,"w"); + + fortran_parse(); + + if (firstpass == 0) NewModule_Creation_0(); + if (firstpass == 0) fclose(fortran_out); +} +#line 2 "fortran.yy.c" + +#line 4 "fortran.yy.c" + +#define YY_INT_ALIGNED short int + +/* A lexical scanner generated by flex */ + +#define yy_create_buffer fortran__create_buffer +#define yy_delete_buffer fortran__delete_buffer +#define yy_flex_debug fortran__flex_debug +#define yy_init_buffer fortran__init_buffer +#define yy_flush_buffer fortran__flush_buffer +#define yy_load_buffer_state fortran__load_buffer_state +#define yy_switch_to_buffer fortran__switch_to_buffer +#define yyin fortran_in +#define yyleng fortran_leng +#define yylex fortran_lex +#define yylineno fortran_lineno +#define yyout fortran_out +#define yyrestart fortran_restart +#define yytext fortran_text +#define yywrap fortran_wrap +#define yyalloc fortran_alloc +#define yyrealloc fortran_realloc +#define yyfree fortran_free + +#define FLEX_SCANNER +#define YY_FLEX_MAJOR_VERSION 2 +#define YY_FLEX_MINOR_VERSION 5 +#define YY_FLEX_SUBMINOR_VERSION 35 +#if YY_FLEX_SUBMINOR_VERSION > 0 +#define FLEX_BETA +#endif + +/* First, we deal with platform-specific or compiler-specific issues. */ + +/* begin standard C headers. */ +#include +#include +#include +#include + +/* end standard C headers. */ + +/* flex integer type definitions */ + +#ifndef FLEXINT_H +#define FLEXINT_H + +/* C99 systems have . Non-C99 systems may or may not. */ + +#if defined (__STDC_VERSION__) && __STDC_VERSION__ >= 199901L + +/* C99 says to define __STDC_LIMIT_MACROS before including stdint.h, + * if you want the limit (max/min) macros for int types. + */ +#ifndef __STDC_LIMIT_MACROS +#define __STDC_LIMIT_MACROS 1 +#endif + +#include +typedef int8_t flex_int8_t; +typedef uint8_t flex_uint8_t; +typedef int16_t flex_int16_t; +typedef uint16_t flex_uint16_t; +typedef int32_t flex_int32_t; +typedef uint32_t flex_uint32_t; +typedef uint64_t flex_uint64_t; +#else +typedef signed char flex_int8_t; +typedef short int flex_int16_t; +typedef int flex_int32_t; +typedef unsigned char flex_uint8_t; +typedef unsigned short int flex_uint16_t; +typedef unsigned int flex_uint32_t; +#endif /* ! C99 */ + +/* Limits of integral types. */ +#ifndef INT8_MIN +#define INT8_MIN (-128) +#endif +#ifndef INT16_MIN +#define INT16_MIN (-32767-1) +#endif +#ifndef INT32_MIN +#define INT32_MIN (-2147483647-1) +#endif +#ifndef INT8_MAX +#define INT8_MAX (127) +#endif +#ifndef INT16_MAX +#define INT16_MAX (32767) +#endif +#ifndef INT32_MAX +#define INT32_MAX (2147483647) +#endif +#ifndef UINT8_MAX +#define UINT8_MAX (255U) +#endif +#ifndef UINT16_MAX +#define UINT16_MAX (65535U) +#endif +#ifndef UINT32_MAX +#define UINT32_MAX (4294967295U) +#endif + +#endif /* ! FLEXINT_H */ + +#ifdef __cplusplus + +/* The "const" storage-class-modifier is valid. */ +#define YY_USE_CONST + +#else /* ! __cplusplus */ + +/* C99 requires __STDC__ to be defined as 1. */ +#if defined (__STDC__) + +#define YY_USE_CONST + +#endif /* defined (__STDC__) */ +#endif /* ! __cplusplus */ + +#ifdef YY_USE_CONST +#define yyconst const +#else +#define yyconst +#endif + +/* Returned upon end-of-file. */ +#define YY_NULL 0 + +/* Promotes a possibly negative, possibly signed char to an unsigned + * integer for use as an array index. If the signed char is negative, + * we want to instead treat it as an 8-bit unsigned char, hence the + * double cast. + */ +#define YY_SC_TO_UI(c) ((unsigned int) (unsigned char) c) + +/* Enter a start condition. This macro really ought to take a parameter, + * but we do it the disgusting crufty way forced on us by the ()-less + * definition of BEGIN. + */ +#define BEGIN (yy_start) = 1 + 2 * + +/* Translate the current start state into a value that can be later handed + * to BEGIN to return to the state. The YYSTATE alias is for lex + * compatibility. + */ +#define YY_START (((yy_start) - 1) / 2) +#define YYSTATE YY_START + +/* Action number for EOF rule of a given start state. */ +#define YY_STATE_EOF(state) (YY_END_OF_BUFFER + state + 1) + +/* Special action meaning "start processing a new file". */ +#define YY_NEW_FILE fortran_restart(fortran_in ) + +#define YY_END_OF_BUFFER_CHAR 0 + +/* Size of default input buffer. */ +#ifndef YY_BUF_SIZE +#define YY_BUF_SIZE 16384 +#endif + +/* The state buf must be large enough to hold one state per character in the main buffer. + */ +#define YY_STATE_BUF_SIZE ((YY_BUF_SIZE + 2) * sizeof(yy_state_type)) + +#ifndef YY_TYPEDEF_YY_BUFFER_STATE +#define YY_TYPEDEF_YY_BUFFER_STATE +typedef struct yy_buffer_state *YY_BUFFER_STATE; +#endif + +#ifndef YY_TYPEDEF_YY_SIZE_T +#define YY_TYPEDEF_YY_SIZE_T +typedef size_t yy_size_t; +#endif + +extern yy_size_t fortran_leng; + +extern FILE *fortran_in, *fortran_out; + +#define EOB_ACT_CONTINUE_SCAN 0 +#define EOB_ACT_END_OF_FILE 1 +#define EOB_ACT_LAST_MATCH 2 + + #define YY_LESS_LINENO(n) + +/* Return all but the first "n" matched characters back to the input stream. */ +#define yyless(n) \ + do \ + { \ + /* Undo effects of setting up fortran_text. */ \ + int yyless_macro_arg = (n); \ + YY_LESS_LINENO(yyless_macro_arg);\ + *yy_cp = (yy_hold_char); \ + YY_RESTORE_YY_MORE_OFFSET \ + (yy_c_buf_p) = yy_cp = yy_bp + yyless_macro_arg - YY_MORE_ADJ; \ + YY_DO_BEFORE_ACTION; /* set up fortran_text again */ \ + } \ + while ( 0 ) + +#define unput(c) yyunput( c, (yytext_ptr) ) + +#ifndef YY_STRUCT_YY_BUFFER_STATE +#define YY_STRUCT_YY_BUFFER_STATE +struct yy_buffer_state + { + FILE *yy_input_file; + + char *yy_ch_buf; /* input buffer */ + char *yy_buf_pos; /* current position in input buffer */ + + /* Size of input buffer in bytes, not including room for EOB + * characters. + */ + yy_size_t yy_buf_size; + + /* Number of characters read into yy_ch_buf, not including EOB + * characters. + */ + yy_size_t yy_n_chars; + + /* Whether we "own" the buffer - i.e., we know we created it, + * and can realloc() it to grow it, and should free() it to + * delete it. + */ + int yy_is_our_buffer; + + /* Whether this is an "interactive" input source; if so, and + * if we're using stdio for input, then we want to use getc() + * instead of fread(), to make sure we stop fetching input after + * each newline. + */ + int yy_is_interactive; + + /* Whether we're considered to be at the beginning of a line. + * If so, '^' rules will be active on the next match, otherwise + * not. + */ + int yy_at_bol; + + int yy_bs_lineno; /**< The line count. */ + int yy_bs_column; /**< The column count. */ + + /* Whether to try to fill the input buffer when we reach the + * end of it. + */ + int yy_fill_buffer; + + int yy_buffer_status; + +#define YY_BUFFER_NEW 0 +#define YY_BUFFER_NORMAL 1 + /* When an EOF's been seen but there's still some text to process + * then we mark the buffer as YY_EOF_PENDING, to indicate that we + * shouldn't try reading from the input source any more. We might + * still have a bunch of tokens to match, though, because of + * possible backing-up. + * + * When we actually see the EOF, we change the status to "new" + * (via fortran_restart()), so that the user can continue scanning by + * just pointing fortran_in at a new input file. + */ +#define YY_BUFFER_EOF_PENDING 2 + + }; +#endif /* !YY_STRUCT_YY_BUFFER_STATE */ + +/* Stack of input buffers. */ +static size_t yy_buffer_stack_top = 0; /**< index of top of stack. */ +static size_t yy_buffer_stack_max = 0; /**< capacity of stack. */ +static YY_BUFFER_STATE * yy_buffer_stack = 0; /**< Stack as an array. */ + +/* We provide macros for accessing buffer states in case in the + * future we want to put the buffer states in a more general + * "scanner state". + * + * Returns the top of the stack, or NULL. + */ +#define YY_CURRENT_BUFFER ( (yy_buffer_stack) \ + ? (yy_buffer_stack)[(yy_buffer_stack_top)] \ + : NULL) + +/* Same as previous macro, but useful when we know that the buffer stack is not + * NULL or when we need an lvalue. For internal use only. + */ +#define YY_CURRENT_BUFFER_LVALUE (yy_buffer_stack)[(yy_buffer_stack_top)] + +/* yy_hold_char holds the character lost when fortran_text is formed. */ +static char yy_hold_char; +static yy_size_t yy_n_chars; /* number of characters read into yy_ch_buf */ +yy_size_t fortran_leng; + +/* Points to current character in buffer. */ +static char *yy_c_buf_p = (char *) 0; +static int yy_init = 0; /* whether we need to initialize */ +static int yy_start = 0; /* start state number */ + +/* Flag which is used to allow fortran_wrap()'s to do buffer switches + * instead of setting up a fresh fortran_in. A bit of a hack ... + */ +static int yy_did_buffer_switch_on_eof; + +void fortran_restart (FILE *input_file ); +void fortran__switch_to_buffer (YY_BUFFER_STATE new_buffer ); +YY_BUFFER_STATE fortran__create_buffer (FILE *file,int size ); +void fortran__delete_buffer (YY_BUFFER_STATE b ); +void fortran__flush_buffer (YY_BUFFER_STATE b ); +void fortran_push_buffer_state (YY_BUFFER_STATE new_buffer ); +void fortran_pop_buffer_state (void ); + +static void fortran_ensure_buffer_stack (void ); +static void fortran__load_buffer_state (void ); +static void fortran__init_buffer (YY_BUFFER_STATE b,FILE *file ); + +#define YY_FLUSH_BUFFER fortran__flush_buffer(YY_CURRENT_BUFFER ) + +YY_BUFFER_STATE fortran__scan_buffer (char *base,yy_size_t size ); +YY_BUFFER_STATE fortran__scan_string (yyconst char *yy_str ); +YY_BUFFER_STATE fortran__scan_bytes (yyconst char *bytes,yy_size_t len ); + +void *fortran_alloc (yy_size_t ); +void *fortran_realloc (void *,yy_size_t ); +void fortran_free (void * ); + +#define yy_new_buffer fortran__create_buffer + +#define yy_set_interactive(is_interactive) \ + { \ + if ( ! YY_CURRENT_BUFFER ){ \ + fortran_ensure_buffer_stack (); \ + YY_CURRENT_BUFFER_LVALUE = \ + fortran__create_buffer(fortran_in,YY_BUF_SIZE ); \ + } \ + YY_CURRENT_BUFFER_LVALUE->yy_is_interactive = is_interactive; \ + } + +#define yy_set_bol(at_bol) \ + { \ + if ( ! YY_CURRENT_BUFFER ){\ + fortran_ensure_buffer_stack (); \ + YY_CURRENT_BUFFER_LVALUE = \ + fortran__create_buffer(fortran_in,YY_BUF_SIZE ); \ + } \ + YY_CURRENT_BUFFER_LVALUE->yy_at_bol = at_bol; \ + } + +#define YY_AT_BOL() (YY_CURRENT_BUFFER_LVALUE->yy_at_bol) + +/* Begin user sect3 */ + +#define fortran_wrap(n) 1 +#define YY_SKIP_YYWRAP + +typedef unsigned char YY_CHAR; + +FILE *fortran_in = (FILE *) 0, *fortran_out = (FILE *) 0; + +typedef int yy_state_type; + +extern int fortran_lineno; + +int fortran_lineno = 1; + +extern char *fortran_text; +#define yytext_ptr fortran_text + +static yy_state_type yy_get_previous_state (void ); +static yy_state_type yy_try_NUL_trans (yy_state_type current_state ); +static int yy_get_next_buffer (void ); +static void yy_fatal_error (yyconst char msg[] ); + +/* Done after the current pattern has been matched and before the + * corresponding action - sets up fortran_text. + */ +#define YY_DO_BEFORE_ACTION \ + (yytext_ptr) = yy_bp; \ + fortran_leng = (yy_size_t) (yy_cp - yy_bp); \ + (yy_hold_char) = *yy_cp; \ + *yy_cp = '\0'; \ + (yy_c_buf_p) = yy_cp; + +#define YY_NUM_RULES 177 +#define YY_END_OF_BUFFER 178 +/* This struct is not used in this scanner, + but its presence is necessary. */ +struct yy_trans_info + { + flex_int32_t yy_verify; + flex_int32_t yy_nxt; + }; +static yyconst flex_int16_t yy_acclist[1577] = + { 0, + 143, 143, 178, 177, 166, 177, 165, 177, 176, 177, + 177, 155, 177, 159, 177, 169, 177, 177, 158, 177, + 158, 177, 158, 177, 161, 177, 156, 177, 140, 177, + 154, 177, 158, 177, 160, 177, 163, 177, 162, 177, + 164, 177, 150, 177, 150, 177, 150, 177, 150, 177, + 150, 177, 150, 177, 150, 177, 150, 177, 150, 177, + 150, 177, 150, 177, 150, 177, 150, 177, 150, 177, + 150, 177, 150, 177, 150, 177, 150, 177, 150, 177, + 150, 177, 150, 177, 166, 177, 165, 175, 177, 176, + 177, 150, 177, 150, 177, 150, 177, 150, 177, 150, + + 177, 177, 177, 173, 177, 177, 177, 177, 143, 177, + 144, 177, 177, 165, 177, 150, 177, 150, 177, 150, + 177, 150, 177, 150, 177, 150, 177, 150, 177, 150, + 177, 150, 177, 150, 177, 150, 177, 150, 177, 150, + 177, 150, 177, 150, 177, 150, 177, 150, 177, 150, + 177, 150, 177, 150, 177, 150, 177, 165, 175, 177, + 166, 177, 158, 177, 154, 177, 150, 177, 150, 177, + 150, 177, 150, 177, 150, 177, 166, 177, 154, 177, + 166, 176, 176, 176, 146, 169, 145, 138, 20, 153, + 139, 137, 34, 154, 136, 35, 33, 18, 36, 150, + + 150, 150, 150, 150, 150, 150, 150, 150, 150, 150, + 150, 150, 150, 42, 150, 150, 150, 150, 150, 150, + 150, 150, 150, 150, 150, 150, 150, 150, 150, 91, + 150, 150, 150, 150, 150, 150, 150, 150, 150, 150, + 150, 150, 150, 150, 150, 150, 150, 150, 150, 150, + 150, 150, 150, 150, 150, 150, 150, 150, 150, 166, + 175, 176, 176, 176, 176, 150, 150, 150, 150, 91, + 150, 150, 173, 143, 142, 150, 150, 150, 150, 150, + 150, 150, 150, 150, 150, 150, 150, 150, 150, 42, + 150, 150, 150, 150, 150, 150, 150, 150, 150, 150, + + 150, 150, 150, 150, 150, 91, 150, 150, 150, 150, + 150, 150, 150, 150, 150, 150, 150, 150, 150, 150, + 150, 150, 150, 150, 150, 150, 150, 150, 150, 150, + 150, 150, 150, 150, 150, 175, 166, 166, 174, 20, + 154, 174, 150, 150, 150, 150, 150, 150, 150, 150, + 150, 150, 91, 150, 150, 166, 154, 176, 176, 141, + 145, 152, 151, 152, 153, 153, 150, 150, 150, 150, + 150, 150, 150, 150, 150, 150, 150, 150, 150, 150, + 150, 150, 150, 150, 150, 9, 150, 150, 150, 150, + 150, 150, 150, 150, 150, 150, 150, 150, 103,16485, + + 150, 150, 150, 150, 150, 150, 150, 150, 150, 150, + 150, 150, 150, 150, 150, 150, 150, 150, 150, 150, + 94, 150, 150, 150, 150, 150, 150, 150, 150, 150, + 150, 150, 150, 150, 150, 150, 150, 150, 150, 150, + 150, 150, 150, 11, 150, 150, 150, 150, 176, 176, + 176, 150, 150, 150, 150, 150, 150, 150, 150, 150, + 150, 150, 150, 150, 150, 150, 150, 150, 150, 150, + 150, 150, 150, 150, 150, 150, 9, 150, 150, 150, + 150, 150, 150, 150, 150, 150, 150, 150, 150, 150, + 150, 150, 150, 150, 150, 150, 150, 150, 150, 150, + + 150, 150, 150, 150, 150, 150, 150, 150, 150, 94, + 150, 150, 150, 150, 150, 150, 150, 150, 150, 150, + 150, 150, 150, 150, 150, 150, 150, 150, 150, 150, + 150, 150, 11, 150, 150, 150, 150, 166, 166, 154, + 150, 150, 150, 150, 150, 150, 150, 150, 150, 150, + 150, 150, 150, 176, 176, 153, 22, 24, 23, 26, + 25, 28, 30, 150, 150, 150, 150, 150, 150, 150, + 15, 150, 150, 150, 150, 150, 150, 150, 150, 150, + 150, 150, 41, 41, 150, 150, 99, 150, 116, 150, + 150, 150, 150, 150, 117, 150, 126, 150, 150, 79, + + 150, 150, 150, 150, 114, 150, 150, 93, 150, 150, + 150, 150, 150, 150, 150, 150, 150, 150, 150, 118, + 150, 150, 150, 150, 115, 14, 150, 150, 63, 150, + 77, 150, 150, 150, 150, 150, 150, 150, 150, 150, + 150, 83, 150, 43, 150, 130, 150, 150, 150, 150, + 150, 72, 150, 150, 150, 76, 150, 57, 150, 150, + 150, 97, 150, 150, 150, 150, 150, 47, 176, 176, + 176, 105, 150, 150, 150, 150, 150, 150,16458, 150, + 150, 150, 150, 150, 150, 150, 15, 150, 150, 150, + 150, 150, 150, 150, 150, 150, 150, 150, 41, 150, + + 150, 99, 150, 150, 150, 150, 150, 150, 150, 150, + 150, 79, 150, 150, 150, 150, 150, 150, 93, 150, + 150, 150, 150, 150, 150, 150, 150, 150, 150, 150, + 150, 150, 150, 150, 14, 150, 150, 63, 150, 77, + 150, 150, 150, 150, 150, 150, 150, 150, 150, 150, + 83, 150, 43, 150, 150, 150, 150, 150, 150, 72, + 150, 150, 150, 76, 150, 57, 150, 150, 150, 97, + 150, 150, 150, 150, 150, 166, 154, 15, 150, 105, + 150, 150, 150, 150, 150, 150, 150, 150, 150, 150, + 150, 150, 150, 150,16458, 176, 176, 157, 32, 21, + + 29, 31, 150, 150, 150, 150, 150, 150, 150, 150, + 52, 150, 150, 150, 150, 150, 134, 150, 150, 150, + 150, 150, 150, 150, 40, 150, 100, 150, 150, 150, + 150, 150, 150, 150, 150, 108, 87, 150, 127, 150, + 93, 102, 150, 150, 95, 150, 150, 150, 150, 150, + 150, 150, 150, 119, 150, 150, 121, 128, 150, 150, + 150, 150, 150, 55, 150, 150, 150, 80, 150, 150, + 150, 150, 82, 129, 150, 150, 150, 150, 150, 150, + 150, 150, 150, 112, 58, 150, 38, 150, 86, 150, + 105,16458, 176, 176, 176, 105, 150, 92, 150, 150, + + 8266, 73, 8266, 150, 150, 150, 150, 150, 150, 150, + 150, 52, 150, 150, 150, 150, 150, 134, 150, 150, + 150, 150, 150, 150, 150, 40, 150, 100, 150, 150, + 150, 150, 150, 150, 150, 150, 87, 150, 150, 150, + 150, 95, 150, 150, 150, 150, 150, 150, 150, 150, + 150, 150, 150, 150, 150, 150, 150, 55, 150, 150, + 150, 80, 150, 150, 150, 150, 150, 150, 150, 150, + 150, 150, 150, 150, 150, 58, 150, 38, 150, 86, + 150, 166, 154, 105, 150, 150, 52, 150, 150, 150, + 150, 150, 150, 150, 134, 150, 150, 150, 16, 176, + + 16, 176, 16, 16, 146, 16, 16, 16, 145, 16, + 16, 16, 16, 16, 16, 27, 150, 150, 150, 150, + 150, 16, 150, 150, 150, 66, 150, 150, 150, 150, + 150, 150, 150, 150, 98, 150, 150, 40, 100, 150, + 150, 150, 150, 150, 133, 150, 150, 102, 8293, 102, + 150, 150, 150, 150, 69, 150, 150, 150, 124, 150, + 150, 37, 150, 150, 150, 150, 150, 150, 150, 150, + 150, 150, 89, 150, 150, 7, 150, 78, 150, 12, + 150, 150, 150, 132, 150, 150, 88, 150, 85, 176, + 176, 16, 176, 150, 150, 150, 150, 150, 150, 150, + + 150, 16, 150, 150, 150, 66, 150, 150, 150, 150, + 150, 150, 150, 150, 98, 150, 150, 150, 150, 150, + 150, 150, 150, 150, 150, 150, 150, 150, 69, 150, + 150, 150, 150, 150, 37, 150, 150, 150, 150, 150, + 150, 150, 150, 150, 150, 89, 150, 150, 7, 150, + 78, 150, 12, 150, 150, 150, 132, 150, 150, 88, + 150, 16, 150, 150, 66, 150, 150, 150, 150, 150, + 16, 150, 150, 150, 17, 17, 176, 17, 17, 146, + 17, 17, 17, 145, 17, 17, 17, 17, 17, 17, + 109, 110, 17, 150, 150, 150, 150, 150, 50, 150, + + 150, 150, 150, 106, 150, 150, 150, 150, 98, 150, + 150, 75, 150, 150, 150, 120, 150, 150, 8293, 150, + 10, 150, 53, 150, 44, 150, 150, 150, 125, 45, + 150, 150, 150, 5, 150, 113, 150, 150, 70, 150, + 150, 90, 150, 2, 150, 150, 150, 122, 131, 150, + 176, 17, 176, 150, 67, 150, 170, 17, 150, 150, + 150, 150, 150, 50, 150, 150, 150, 150, 106, 150, + 150, 150, 150, 150, 150, 75, 150, 150, 150, 150, + 150, 150, 10, 150, 53, 150, 44, 150, 150, 150, + 45, 150, 150, 150, 5, 150, 150, 150, 70, 150, + + 150, 90, 150, 2, 150, 150, 150, 150, 170, 17, + 17, 150, 150, 50, 150, 150, 150, 150, 150, 150, + 3, 150, 150, 150, 150, 150, 4, 150, 150, 150, + 150, 150, 150, 75, 150, 59, 150, 150, 68, 150, + 8, 150, 13, 150, 150, 150, 150, 84, 150, 71, + 150, 150, 150, 150, 150, 150, 176, 62, 150, 150, + 150, 3, 150, 150, 150, 150, 150, 4, 150, 150, + 150, 150, 150, 150, 150, 59, 150, 150, 68, 150, + 8, 150, 13, 150, 150, 150, 150, 84, 150, 71, + 150, 150, 150, 150, 150, 150, 150, 150, 62, 150, + + 4, 150, 150, 137, 150, 150, 135, 150, 46, 150, + 150, 150, 54, 150, 150, 150, 61, 150, 59, 107, + 150, 150, 96, 150, 111, 150, 64, 150, 123, 65, + 150, 150, 150, 62, 176, 147, 150, 149, 150, 150, + 135, 150, 46, 150, 150, 150, 54, 150, 150, 150, + 61, 150, 107, 150, 150, 96, 150, 150, 64, 150, + 65, 150, 150, 150, 46, 150, 150, 147, 150, 168, + 137, 150, 150, 39, 150, 6, 150, 150, 150, 61, + 60, 107, 150, 150, 104, 150, 1, 150, 147, 176, + 150, 150, 39, 150, 6, 150, 150, 150, 150, 150, + + 104, 150, 1, 150, 167, 39, 150, 51, 150, 150, + 150, 56, 150, 150, 104, 176, 51, 150, 150, 150, + 56, 150, 150, 168, 150, 150, 150, 176, 150, 150, + 150, 167, 19, 49, 150, 150, 150, 176, 148, 173, + 49, 150, 150, 150, 167, 167, 49, 150, 150, 176, + 150, 150, 48, 150, 81, 150, 176, 48, 150, 81, + 150, 167, 48, 81, 176, 176, 176, 176, 176, 176, + 171, 171, 171, 174, 172, 173 + } ; + +static yyconst flex_int16_t yy_accept[1856] = + { 0, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, + 3, 3, 3, 3, 3, 4, 5, 7, 9, 11, + 12, 14, 16, 18, 19, 21, 23, 25, 27, 29, + 31, 33, 35, 37, 39, 41, 43, 45, 47, 49, + 51, 53, 55, 57, 59, 61, 63, 65, 67, 69, + 71, 73, 75, 77, 79, 81, 83, 85, 87, 90, + 92, 94, 96, 98, 100, 102, 103, 104, 106, 107, + 108, 109, 111, 113, 114, 116, 118, 120, 122, 124, + 126, 128, 130, 132, 134, 136, 138, 140, 142, 144, + 146, 148, 150, 152, 154, 156, 158, 161, 163, 165, + + 167, 169, 171, 173, 175, 177, 179, 181, 181, 181, + 182, 183, 184, 185, 185, 186, 186, 186, 187, 187, + 187, 187, 187, 188, 188, 188, 188, 188, 189, 189, + 189, 189, 190, 190, 191, 191, 191, 191, 191, 191, + 191, 191, 191, 191, 191, 192, 193, 194, 194, 195, + 195, 196, 197, 198, 199, 200, 201, 202, 203, 204, + 205, 206, 207, 208, 209, 210, 211, 212, 213, 214, + 216, 217, 218, 219, 220, 221, 222, 223, 224, 225, + 226, 227, 228, 229, 230, 232, 233, 234, 235, 236, + 237, 238, 239, 240, 241, 242, 243, 244, 245, 246, + + 247, 248, 249, 250, 251, 252, 253, 254, 255, 256, + 257, 258, 259, 260, 260, 261, 262, 262, 262, 262, + 262, 262, 262, 262, 263, 263, 264, 265, 266, 266, + 267, 268, 269, 270, 272, 273, 273, 274, 274, 274, + 274, 274, 275, 275, 276, 276, 276, 276, 276, 276, + 276, 277, 278, 279, 280, 281, 282, 283, 284, 285, + 286, 287, 288, 289, 290, 292, 293, 294, 295, 296, + 297, 298, 299, 300, 301, 302, 303, 304, 305, 306, + 308, 309, 310, 311, 312, 313, 314, 315, 316, 317, + 318, 319, 320, 321, 322, 323, 324, 325, 326, 327, + + 328, 329, 330, 331, 332, 333, 334, 335, 336, 336, + 337, 337, 337, 338, 339, 339, 339, 340, 341, 341, + 341, 341, 341, 342, 343, 343, 344, 345, 346, 347, + 348, 349, 350, 351, 352, 353, 355, 356, 357, 357, + 357, 358, 358, 358, 358, 359, 360, 360, 360, 360, + 360, 360, 360, 360, 360, 362, 362, 362, 362, 362, + 362, 362, 362, 362, 362, 362, 362, 362, 362, 362, + 362, 362, 362, 362, 362, 362, 362, 362, 362, 362, + 362, 362, 362, 362, 362, 362, 362, 363, 366, 366, + 367, 368, 369, 370, 371, 372, 373, 374, 375, 376, + + 377, 378, 379, 380, 381, 382, 383, 383, 384, 385, + 386, 388, 389, 390, 391, 392, 393, 394, 395, 396, + 397, 398, 398, 399, 399, 401, 402, 403, 404, 405, + 406, 407, 408, 409, 410, 411, 412, 413, 414, 415, + 416, 417, 418, 419, 420, 421, 423, 424, 425, 426, + 427, 428, 429, 430, 431, 432, 433, 434, 435, 436, + 437, 438, 439, 440, 441, 442, 443, 444, 446, 447, + 448, 449, 449, 449, 449, 449, 449, 449, 449, 449, + 449, 450, 451, 452, 452, 453, 454, 455, 456, 457, + 458, 458, 458, 458, 458, 458, 458, 458, 458, 458, + + 458, 458, 458, 459, 460, 461, 462, 463, 464, 465, + 466, 467, 468, 469, 470, 471, 472, 473, 474, 475, + 476, 477, 479, 480, 481, 482, 483, 484, 485, 486, + 487, 488, 489, 490, 491, 492, 493, 494, 495, 496, + 497, 498, 499, 500, 501, 502, 503, 504, 505, 506, + 507, 508, 509, 510, 512, 513, 514, 515, 516, 517, + 518, 519, 520, 521, 522, 523, 524, 525, 526, 527, + 528, 529, 530, 531, 532, 533, 535, 536, 537, 538, + 538, 538, 538, 538, 539, 539, 540, 540, 540, 540, + 540, 540, 540, 541, 541, 542, 543, 544, 545, 546, + + 547, 548, 549, 550, 551, 552, 553, 554, 554, 554, + 554, 554, 555, 556, 556, 556, 556, 556, 556, 556, + 556, 556, 556, 556, 556, 556, 556, 556, 556, 556, + 556, 556, 557, 557, 557, 558, 558, 559, 560, 561, + 562, 562, 563, 563, 563, 564, 564, 564, 564, 564, + 564, 564, 564, 564, 564, 564, 564, 565, 566, 567, + 568, 569, 570, 571, 573, 574, 575, 576, 577, 578, + 579, 580, 581, 582, 583, 584, 586, 587, 589, 589, + 590, 591, 592, 593, 594, 595, 595, 596, 597, 597, + 598, 599, 600, 602, 603, 604, 605, 605, 606, 607, + + 608, 608, 610, 610, 610, 610, 610, 611, 612, 613, + 614, 615, 616, 617, 618, 619, 620, 620, 621, 622, + 623, 624, 625, 625, 626, 628, 629, 631, 633, 634, + 635, 636, 637, 638, 639, 640, 641, 642, 644, 646, + 646, 647, 648, 649, 650, 651, 652, 654, 655, 656, + 658, 660, 661, 662, 664, 665, 666, 667, 668, 669, + 669, 669, 669, 669, 669, 669, 670, 671, 672, 672, + 674, 675, 676, 677, 678, 680, 680, 680, 680, 680, + 680, 680, 680, 680, 680, 681, 682, 683, 684, 685, + 686, 687, 689, 690, 691, 692, 693, 694, 695, 696, + + 697, 698, 699, 701, 702, 704, 705, 706, 707, 708, + 709, 710, 711, 712, 714, 715, 716, 717, 718, 719, + 721, 722, 723, 724, 725, 726, 727, 728, 729, 730, + 731, 732, 733, 734, 735, 737, 738, 740, 742, 743, + 744, 745, 746, 747, 748, 749, 750, 751, 753, 755, + 756, 757, 758, 759, 760, 762, 763, 764, 766, 768, + 769, 770, 772, 773, 774, 775, 776, 776, 776, 776, + 777, 777, 777, 777, 777, 777, 778, 778, 780, 782, + 783, 784, 785, 786, 787, 788, 789, 790, 791, 792, + 793, 794, 796, 796, 796, 796, 797, 798, 798, 798, + + 798, 798, 798, 799, 799, 799, 799, 799, 799, 799, + 800, 801, 801, 802, 803, 803, 803, 803, 803, 803, + 803, 804, 805, 806, 807, 808, 809, 810, 811, 813, + 814, 815, 816, 817, 819, 820, 821, 822, 823, 823, + 824, 825, 825, 825, 825, 825, 825, 827, 829, 830, + 831, 832, 833, 834, 835, 836, 836, 837, 839, 839, + 840, 841, 842, 842, 842, 842, 843, 844, 845, 847, + 848, 849, 850, 851, 852, 853, 854, 854, 855, 856, + 857, 857, 858, 858, 859, 860, 861, 862, 863, 864, + 866, 867, 868, 870, 871, 872, 873, 873, 874, 874, + + 875, 876, 877, 878, 879, 880, 881, 882, 883, 884, + 884, 885, 887, 889, 891, 892, 892, 892, 892, 892, + 893, 894, 895, 896, 896, 897, 898, 899, 900, 901, + 902, 903, 904, 904, 904, 904, 904, 904, 904, 905, + 906, 907, 908, 909, 910, 911, 912, 914, 915, 916, + 917, 918, 920, 921, 922, 923, 924, 925, 926, 928, + 930, 931, 932, 933, 934, 935, 936, 937, 939, 940, + 941, 942, 944, 945, 946, 947, 948, 949, 950, 951, + 952, 953, 954, 955, 956, 957, 958, 960, 961, 962, + 964, 965, 966, 967, 968, 969, 970, 971, 972, 973, + + 974, 975, 976, 978, 980, 982, 982, 982, 982, 983, + 983, 983, 983, 983, 983, 984, 984, 985, 986, 987, + 989, 990, 991, 992, 993, 994, 995, 997, 998, 999, + 999, 999, 1000, 1001, 1003, 1003, 1004, 1006, 1006, 1007, + 1008, 1010, 1010, 1010, 1010, 1010, 1011, 1012, 1013, 1014, + 1015, 1016, 1017, 1017, 1017, 1017, 1017, 1018, 1019, 1020, + 1021, 1022, 1024, 1025, 1026, 1028, 1029, 1030, 1031, 1032, + 1033, 1034, 1035, 1035, 1035, 1037, 1038, 1039, 1040, 1040, + 1040, 1040, 1041, 1042, 1043, 1044, 1045, 1045, 1046, 1047, + 1048, 1048, 1049, 1049, 1049, 1049, 1049, 1050, 1051, 1052, + + 1053, 1054, 1055, 1057, 1058, 1059, 1059, 1060, 1061, 1062, + 1064, 1065, 1066, 1067, 1068, 1069, 1070, 1071, 1072, 1073, + 1075, 1076, 1078, 1080, 1082, 1083, 1084, 1086, 1087, 1089, + 1089, 1090, 1090, 1090, 1090, 1091, 1092, 1094, 1094, 1095, + 1096, 1097, 1097, 1097, 1097, 1097, 1097, 1097, 1098, 1099, + 1100, 1101, 1102, 1104, 1105, 1106, 1108, 1109, 1110, 1111, + 1112, 1113, 1114, 1115, 1117, 1118, 1119, 1120, 1121, 1122, + 1123, 1124, 1125, 1126, 1127, 1128, 1129, 1131, 1132, 1133, + 1134, 1135, 1137, 1138, 1139, 1140, 1141, 1142, 1143, 1144, + 1145, 1146, 1148, 1149, 1151, 1153, 1155, 1156, 1157, 1159, + + 1160, 1162, 1162, 1162, 1162, 1162, 1163, 1163, 1164, 1165, + 1167, 1168, 1169, 1170, 1171, 1173, 1174, 1175, 1175, 1176, + 1178, 1179, 1181, 1182, 1183, 1185, 1185, 1186, 1187, 1188, + 1189, 1190, 1191, 1191, 1191, 1191, 1191, 1191, 1192, 1192, + 1193, 1195, 1196, 1197, 1198, 1199, 1201, 1202, 1203, 1204, + 1206, 1207, 1207, 1208, 1209, 1210, 1210, 1211, 1211, 1211, + 1211, 1212, 1214, 1215, 1216, 1216, 1217, 1218, 1219, 1220, + 1220, 1220, 1221, 1223, 1225, 1227, 1228, 1229, 1229, 1230, + 1232, 1232, 1233, 1234, 1236, 1236, 1237, 1238, 1239, 1241, + 1242, 1244, 1246, 1247, 1247, 1248, 1248, 1249, 1249, 1250, + + 1251, 1251, 1251, 1251, 1252, 1254, 1254, 1255, 1256, 1257, + 1257, 1257, 1257, 1258, 1258, 1258, 1260, 1261, 1262, 1263, + 1264, 1266, 1267, 1268, 1269, 1271, 1272, 1273, 1274, 1275, + 1276, 1278, 1279, 1280, 1281, 1282, 1283, 1285, 1287, 1289, + 1290, 1291, 1293, 1294, 1295, 1297, 1298, 1299, 1301, 1302, + 1304, 1306, 1307, 1308, 1309, 1309, 1310, 1310, 1311, 1311, + 1313, 1314, 1316, 1317, 1318, 1319, 1320, 1320, 1320, 1320, + 1320, 1320, 1321, 1323, 1324, 1325, 1326, 1327, 1329, 1330, + 1331, 1331, 1331, 1332, 1333, 1333, 1334, 1334, 1335, 1335, + 1336, 1338, 1339, 1341, 1343, 1343, 1345, 1346, 1347, 1347, + + 1348, 1350, 1352, 1353, 1354, 1355, 1355, 1356, 1357, 1357, + 1357, 1358, 1358, 1360, 1361, 1361, 1361, 1361, 1361, 1361, + 1362, 1364, 1365, 1366, 1367, 1368, 1370, 1371, 1372, 1373, + 1374, 1375, 1376, 1378, 1379, 1381, 1383, 1385, 1386, 1387, + 1388, 1390, 1392, 1393, 1394, 1395, 1396, 1397, 1397, 1397, + 1397, 1398, 1399, 1401, 1403, 1404, 1404, 1404, 1404, 1404, + 1404, 1404, 1404, 1405, 1406, 1407, 1409, 1411, 1412, 1413, + 1415, 1415, 1415, 1416, 1417, 1417, 1419, 1419, 1420, 1422, + 1423, 1425, 1425, 1426, 1426, 1427, 1429, 1429, 1430, 1432, + 1432, 1433, 1434, 1435, 1435, 1436, 1436, 1438, 1438, 1438, + + 1438, 1439, 1440, 1441, 1443, 1445, 1446, 1447, 1449, 1450, + 1451, 1453, 1455, 1456, 1458, 1459, 1461, 1463, 1464, 1465, + 1465, 1465, 1465, 1467, 1468, 1470, 1470, 1470, 1471, 1471, + 1471, 1471, 1472, 1473, 1474, 1476, 1478, 1478, 1478, 1479, + 1480, 1481, 1481, 1482, 1483, 1484, 1484, 1485, 1485, 1487, + 1489, 1490, 1491, 1491, 1491, 1491, 1492, 1493, 1495, 1497, + 1498, 1499, 1500, 1501, 1503, 1505, 1505, 1505, 1505, 1506, + 1506, 1508, 1508, 1508, 1508, 1508, 1508, 1508, 1510, 1510, + 1510, 1510, 1510, 1511, 1512, 1514, 1514, 1515, 1516, 1517, + 1517, 1517, 1517, 1519, 1520, 1521, 1523, 1524, 1524, 1524, + + 1524, 1524, 1524, 1524, 1524, 1524, 1524, 1524, 1524, 1525, + 1525, 1525, 1525, 1525, 1526, 1527, 1527, 1528, 1529, 1529, + 1529, 1529, 1530, 1531, 1532, 1532, 1532, 1532, 1532, 1532, + 1532, 1532, 1532, 1532, 1532, 1532, 1533, 1533, 1533, 1533, + 1533, 1533, 1534, 1534, 1534, 1536, 1537, 1537, 1538, 1539, + 1539, 1539, 1539, 1541, 1543, 1544, 1545, 1545, 1545, 1545, + 1545, 1545, 1545, 1546, 1546, 1546, 1546, 1547, 1547, 1547, + 1547, 1547, 1548, 1548, 1549, 1549, 1550, 1551, 1551, 1551, + 1552, 1553, 1553, 1553, 1553, 1553, 1553, 1553, 1553, 1553, + 1553, 1553, 1553, 1555, 1555, 1557, 1558, 1558, 1558, 1560, + + 1562, 1562, 1562, 1562, 1562, 1562, 1562, 1563, 1563, 1564, + 1565, 1566, 1566, 1566, 1566, 1566, 1566, 1566, 1566, 1566, + 1567, 1567, 1567, 1567, 1567, 1567, 1567, 1567, 1567, 1568, + 1568, 1568, 1568, 1568, 1569, 1569, 1569, 1569, 1570, 1570, + 1570, 1570, 1571, 1572, 1572, 1573, 1573, 1573, 1575, 1575, + 1575, 1575, 1575, 1577, 1577 + } ; + +static yyconst flex_int32_t yy_ec[256] = + { 0, + 1, 1, 1, 1, 1, 1, 1, 1, 2, 3, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 4, 5, 6, 7, 8, 9, 10, 11, 12, + 13, 14, 15, 16, 17, 18, 19, 20, 20, 20, + 20, 20, 20, 20, 20, 20, 20, 21, 22, 23, + 24, 25, 1, 1, 26, 27, 28, 29, 30, 31, + 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, + 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, + 52, 1, 53, 1, 54, 1, 55, 56, 57, 58, + + 59, 60, 61, 62, 63, 35, 64, 65, 66, 67, + 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, + 78, 79, 1, 80, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1 + } ; + +static yyconst flex_int32_t yy_meta[81] = + { 0, + 1, 2, 3, 2, 4, 5, 4, 4, 1, 4, + 6, 7, 8, 4, 9, 10, 11, 12, 13, 14, + 1, 4, 1, 1, 1, 15, 14, 14, 14, 14, + 15, 16, 17, 17, 17, 17, 16, 17, 16, 16, + 17, 17, 16, 16, 16, 16, 17, 17, 17, 17, + 17, 1, 1, 18, 15, 14, 14, 14, 14, 15, + 16, 17, 17, 17, 16, 17, 16, 16, 17, 17, + 16, 16, 16, 16, 17, 17, 17, 17, 17, 5 + } ; + +static yyconst flex_int16_t yy_base[2007] = + { 0, + 0, 79, 0, 0, 0, 151, 3481, 84, 88, 91, + 224, 303, 0, 375, 3457, 65, 99, 9193, 73, 100, + 74, 90, 308, 117, 325, 126, 137, 133, 447, 386, + 382, 144, 143, 285, 390, 302, 425, 449, 499, 497, + 547, 594, 443, 324, 535, 495, 503, 582, 618, 630, + 639, 398, 685, 688, 697, 689, 450, 769, 216, 538, + 583, 749, 745, 800, 802, 9193, 3376, 9193, 789, 114, + 155, 96, 9193, 3350, 851, 841, 692, 912, 860, 961, + 910, 853, 858, 948, 895, 896, 977, 1009, 1020, 1036, + 1033, 1069, 1085, 1081, 1118, 1123, 1162, 203, 908, 316, + + 1219, 71, 1145, 100, 1274, 339, 363, 106, 127, 198, + 0, 140, 144, 3297, 3293, 308, 348, 347, 3264, 181, + 698, 415, 3250, 434, 899, 631, 819, 9193, 1300, 1317, + 1342, 9193, 1343, 697, 307, 331, 446, 607, 613, 363, + 425, 1050, 1361, 1167, 9193, 9193, 9193, 1311, 1358, 304, + 9193, 9193, 9193, 9193, 9193, 0, 831, 302, 435, 473, + 508, 359, 516, 367, 542, 749, 411, 906, 550, 1142, + 549, 489, 576, 624, 653, 926, 698, 692, 723, 735, + 804, 1040, 1301, 805, 1366, 1360, 810, 857, 489, 976, + 861, 957, 958, 965, 972, 1060, 973, 1138, 1340, 1089, + + 570, 1393, 1003, 1019, 1012, 1403, 573, 1027, 615, 649, + 765, 1292, 807, 0, 1362, 1190, 3251, 1404, 891, 1071, + 1092, 1390, 1195, 3244, 1449, 993, 1322, 1402, 957, 1405, + 1135, 1265, 1327, 1436, 1345, 3239, 9193, 1453, 1421, 1459, + 1460, 209, 3117, 3081, 1201, 1493, 1304, 3082, 3075, 1497, + 1489, 1507, 1458, 1496, 1514, 1520, 1515, 1553, 1540, 1554, + 1564, 1551, 1588, 1587, 1601, 1595, 1606, 1614, 1627, 1637, + 1658, 1660, 1650, 1555, 1661, 1681, 1712, 1725, 1702, 1716, + 1750, 1751, 1764, 1769, 1782, 1800, 1804, 1805, 1806, 1830, + 1840, 1807, 1848, 1870, 1872, 1880, 1902, 1904, 1911, 1808, + + 1926, 1935, 1944, 1965, 1962, 1975, 1984, 1999, 1760, 2047, + 2061, 3034, 1652, 318, 782, 3022, 9193, 3009, 1464, 1533, + 1907, 2038, 2066, 2074, 1484, 2136, 2216, 2045, 2048, 2050, + 2125, 2062, 2128, 1913, 2138, 2139, 2214, 1748, 2241, 2000, + 2244, 1673, 1362, 1401, 1443, 1448, 2996, 1486, 1595, 2991, + 1380, 1802, 2247, 1913, 2970, 2933, 2070, 2267, 497, 880, + 2289, 2290, 2918, 2313, 2314, 1474, 1041, 1124, 1077, 2280, + 2913, 2856, 2855, 2843, 2293, 1533, 2840, 1546, 1772, 2334, + 1884, 2844, 2810, 2354, 2367, 2804, 9193, 2345, 2782, 2771, + 1271, 1316, 1601, 1609, 1346, 1616, 1634, 1654, 1668, 1711, + + 1947, 2142, 1735, 1783, 1581, 1663, 2362, 2372, 1790, 1872, + 2444, 2035, 1892, 2381, 2129, 1914, 1952, 1812, 2252, 1852, + 1998, 2345, 1852, 1528, 1733, 1963, 2046, 2045, 2047, 2269, + 2067, 2057, 2130, 2147, 2261, 2256, 2134, 2293, 2293, 2322, + 2295, 2145, 2136, 2213, 2345, 0, 2354, 2317, 2345, 2359, + 2359, 2362, 2360, 2373, 2412, 2353, 2354, 2367, 2381, 2383, + 2386, 2387, 2392, 2394, 2389, 2400, 2396, 0, 2400, 2407, + 2406, 2761, 2402, 2765, 2409, 2415, 2410, 2416, 2414, 2421, + 2461, 2460, 2463, 2438, 2444, 2466, 2449, 2449, 2455, 2465, + 2497, 2528, 2744, 2508, 2531, 2749, 2748, 2536, 2540, 2544, + + 2673, 2613, 2488, 2493, 2516, 2512, 2525, 2505, 2531, 2518, + 2547, 2554, 2558, 2557, 2563, 2566, 2560, 2562, 2567, 2579, + 2574, 2639, 2570, 2573, 2642, 2575, 2602, 2608, 2581, 2647, + 2619, 2631, 2561, 2572, 2649, 2636, 2652, 2661, 2659, 2651, + 2620, 2667, 2675, 2666, 2657, 2672, 2687, 2703, 2689, 2691, + 2671, 2706, 2713, 2610, 2710, 2678, 2721, 2730, 2731, 2734, + 2732, 2738, 2755, 2735, 2736, 2737, 2759, 2760, 2740, 2739, + 2758, 2751, 2782, 2741, 2771, 2590, 2774, 2750, 2783, 2821, + 2828, 2503, 2832, 2888, 2549, 388, 2110, 2837, 2801, 2802, + 2838, 2847, 2882, 2818, 2961, 3041, 2822, 2842, 2864, 2888, + + 2959, 2869, 2845, 2851, 2900, 3031, 2850, 2815, 2871, 2881, + 2875, 2886, 2891, 2949, 2929, 2043, 2860, 2490, 2996, 3066, + 2988, 2993, 3018, 3079, 3007, 3013, 3085, 3102, 2654, 3080, + 2400, 2333, 2324, 3105, 9193, 2303, 9193, 9193, 9193, 9193, + 3106, 9193, 2885, 2302, 9193, 2282, 2860, 3109, 2286, 2276, + 3132, 3144, 3163, 2264, 2263, 3173, 2947, 2956, 2956, 2973, + 3054, 3058, 2995, 0, 3071, 3082, 3051, 3079, 3081, 3096, + 3101, 3106, 3106, 3114, 2227, 2224, 3125, 3136, 3211, 9193, + 3129, 3114, 3120, 3136, 3131, 3183, 9193, 3141, 3187, 9193, + 3150, 3150, 0, 3153, 3196, 3169, 3201, 9193, 3202, 3163, + + 3169, 0, 3067, 2223, 2200, 3215, 3187, 3164, 3184, 3199, + 3209, 3200, 3204, 3212, 3220, 3256, 3262, 9193, 3221, 3214, + 3286, 3287, 3290, 9193, 0, 3218, 0, 3223, 3225, 3230, + 3242, 3232, 3240, 3252, 3272, 3257, 3268, 3304, 0, 3305, + 9193, 3313, 3261, 3275, 3275, 3280, 0, 3292, 3293, 3277, + 0, 3286, 3300, 0, 3331, 3304, 3306, 3308, 9193, 3309, + 3296, 3316, 3316, 3314, 3315, 3319, 3345, 3350, 3313, 462, + 3332, 602, 3331, 3349, 3381, 3357, 3373, 3367, 3394, 3399, + 3409, 3417, 2201, 2195, 3361, 3375, 3379, 3409, 3415, 3405, + 3388, 2191, 3422, 3423, 3391, 3421, 3424, 3427, 3426, 3435, + + 3437, 3436, 427, 3441, 3465, 3439, 3442, 3451, 3438, 3447, + 3446, 3443, 3449, 2174, 3452, 3515, 3468, 3522, 3459, 2129, + 3471, 3462, 3486, 3493, 3511, 3517, 3494, 3526, 3509, 3545, + 3534, 3537, 3551, 3564, 2125, 3542, 2120, 3535, 3539, 3554, + 3541, 3567, 3570, 3574, 3578, 3560, 3579, 3581, 2113, 3593, + 3583, 3586, 3587, 3595, 2106, 3596, 3607, 3603, 2064, 3605, + 3606, 2042, 3635, 3611, 3622, 3625, 3664, 3683, 3420, 3687, + 3659, 3674, 3678, 3653, 3641, 3710, 3680, 3780, 3860, 3691, + 3646, 3706, 3702, 3709, 3754, 3825, 3885, 3888, 685, 3700, + 3774, 3818, 3580, 3672, 0, 3690, 0, 3748, 532, 3890, + + 2885, 1789, 9193, 3901, 3904, 2016, 3725, 3907, 3966, 9193, + 9193, 2012, 9193, 9193, 3757, 3762, 3806, 3926, 1995, 3993, + 3588, 3657, 3713, 3788, 3773, 4050, 3777, 3787, 0, 3780, + 3793, 3783, 3819, 0, 3858, 3867, 3863, 3794, 3960, 3879, + 3901, 3901, 3962, 3969, 3951, 3969, 0, 0, 3967, 3964, + 3976, 3983, 3978, 3892, 3974, 4013, 9193, 0, 4023, 9193, + 3977, 9193, 4074, 4075, 4092, 4098, 3986, 3987, 0, 3999, + 3994, 4035, 4045, 4053, 4115, 4048, 4116, 9193, 4071, 4070, + 4121, 9193, 4129, 9193, 4072, 4096, 4099, 4085, 4102, 0, + 4104, 4102, 0, 4093, 4115, 4114, 3944, 9193, 4144, 9193, + + 4103, 4104, 4112, 4115, 4113, 4129, 4118, 4118, 4122, 4172, + 9193, 0, 0, 3948, 1158, 4134, 2019, 4143, 4137, 4181, + 4147, 4179, 1962, 4150, 2606, 4153, 2935, 4154, 4163, 4199, + 9193, 3834, 4196, 4197, 3771, 3949, 4202, 4220, 4202, 4209, + 4214, 4211, 4215, 4282, 4240, 4223, 1961, 4269, 4272, 4268, + 4274, 1957, 4275, 4307, 4276, 4315, 4309, 4313, 1898, 1893, + 4314, 4311, 4319, 4316, 4321, 4225, 4318, 1871, 4320, 4327, + 4329, 1857, 4322, 4330, 4323, 4324, 4334, 4229, 4325, 4335, + 4347, 4370, 4361, 4373, 4378, 4356, 1826, 4364, 4385, 1822, + 4394, 4396, 4397, 4398, 4402, 4404, 4400, 4405, 4406, 4408, + + 4407, 4410, 1796, 1778, 4253, 4258, 4457, 4198, 4482, 3071, + 4433, 4442, 4438, 1764, 4488, 4435, 4079, 4558, 4638, 4193, + 4438, 4444, 4466, 4400, 4468, 4718, 4211, 4485, 4473, 4214, + 0, 9193, 0, 0, 1208, 1760, 1754, 3846, 4509, 4518, + 1738, 4582, 4583, 4414, 4798, 4410, 4534, 4604, 4610, 4611, + 1722, 9193, 4552, 4587, 4665, 4669, 4243, 4595, 4878, 4479, + 4552, 0, 4394, 4548, 0, 4555, 4562, 4561, 4487, 4564, + 4560, 4710, 4645, 4644, 0, 4648, 9193, 9193, 4643, 4640, + 4652, 4656, 4657, 4642, 4652, 4742, 4745, 9193, 4719, 4708, + 4748, 4679, 4760, 4765, 3930, 1722, 4829, 4844, 4720, 4726, + + 4727, 4710, 0, 4716, 4723, 4825, 9193, 4834, 4760, 4835, + 4782, 4784, 4903, 4732, 4790, 4800, 4830, 4765, 4868, 0, + 4767, 0, 0, 0, 4908, 4909, 4913, 4869, 0, 4428, + 9193, 4814, 4879, 4887, 4917, 1699, 1678, 4890, 4884, 3893, + 4899, 4925, 4905, 3955, 4487, 4596, 4695, 4936, 4959, 4985, + 4966, 4946, 1673, 4919, 4968, 1647, 4956, 4972, 4970, 5014, + 4973, 5011, 5019, 1617, 4923, 5021, 5022, 4977, 5024, 5026, + 4926, 5016, 5023, 5028, 5032, 5029, 1581, 5031, 5033, 5066, + 5046, 5051, 5060, 5063, 5091, 5070, 5037, 5056, 5061, 5094, + 5064, 1567, 5074, 1534, 1523, 1514, 5114, 5119, 5131, 5095, + + 1502, 4788, 4862, 4915, 1488, 1428, 5076, 5171, 5251, 5331, + 5070, 5083, 5089, 5085, 0, 4870, 5136, 5093, 9193, 0, + 1409, 1395, 5141, 5147, 1357, 4953, 5144, 5195, 5217, 5223, + 5224, 1341, 4530, 4700, 5198, 5278, 5205, 9193, 5212, 9193, + 0, 5259, 4913, 5057, 5139, 0, 5175, 5188, 5194, 0, + 5164, 5323, 5182, 5236, 9193, 5254, 5244, 5260, 5261, 5250, + 5266, 0, 5269, 5270, 5306, 9193, 5261, 5318, 5357, 5345, + 5374, 5320, 0, 0, 0, 5332, 5334, 5386, 9193, 0, + 5371, 5328, 5334, 0, 5398, 9193, 5364, 5338, 0, 5364, + 0, 0, 5357, 5411, 5368, 5404, 9193, 5412, 9193, 5371, + + 5378, 5159, 5383, 582, 1346, 1274, 5374, 5163, 5391, 796, + 5417, 5307, 9193, 5209, 5244, 1320, 5421, 5423, 5424, 5427, + 1309, 5432, 5439, 5418, 1215, 5438, 5447, 5440, 5446, 5456, + 1214, 5455, 5460, 5430, 5453, 5452, 1135, 1114, 1109, 5467, + 5461, 1094, 5462, 5458, 1078, 5463, 5496, 1024, 5468, 962, + 931, 5469, 5501, 5474, 5536, 904, 5429, 889, 804, 0, + 5463, 0, 5488, 5452, 5491, 5506, 5541, 5544, 5555, 5565, + 5575, 5505, 0, 5497, 5512, 5511, 5521, 0, 5517, 5533, + 5533, 5533, 5543, 5536, 5540, 5556, 5559, 9193, 5559, 5546, + 0, 5553, 0, 0, 5608, 0, 5565, 5603, 5553, 5558, + + 0, 0, 5559, 5604, 5583, 5588, 5559, 5578, 5585, 5605, + 5631, 5606, 0, 5606, 5636, 5637, 5642, 5646, 0, 5634, + 878, 5635, 5646, 5638, 5652, 848, 5649, 5653, 5655, 5656, + 5666, 5667, 834, 5660, 822, 817, 808, 5650, 5680, 5668, + 778, 774, 5670, 5714, 5676, 5682, 5664, 5740, 5735, 5672, + 5629, 5684, 0, 0, 5725, 5744, 1469, 5748, 5730, 5755, + 5759, 5777, 5773, 5729, 5722, 0, 0, 5725, 5734, 0, + 5733, 5738, 5731, 5745, 5755, 5799, 5743, 9193, 0, 5758, + 0, 5802, 9193, 5749, 5762, 0, 5803, 9193, 0, 5764, + 5761, 5779, 9193, 5780, 5809, 5773, 0, 5815, 5818, 5820, + + 0, 5820, 5825, 751, 743, 5826, 5828, 726, 5827, 5831, + 5843, 703, 5832, 690, 5834, 638, 627, 5845, 5848, 5838, + 5292, 5829, 0, 5788, 602, 1996, 5890, 2158, 5862, 5906, + 5909, 596, 5846, 5914, 0, 0, 5811, 5858, 5819, 5867, + 5919, 5920, 9193, 9193, 5876, 5889, 5890, 5897, 0, 0, + 9193, 938, 540, 5926, 5930, 5931, 5935, 549, 451, 5899, + 5937, 5938, 5939, 383, 379, 5940, 5971, 5976, 5941, 979, + 0, 5991, 6003, 5949, 6007, 6017, 369, 0, 6021, 6033, + 5923, 5914, 5933, 5958, 0, 5973, 5985, 9193, 5979, 5985, + 1003, 6012, 368, 6026, 6031, 322, 6035, 6049, 6056, 6061, + + 312, 198, 6076, 6092, 6059, 6037, 6088, 6105, 6109, 6112, + 6122, 6009, 6005, 6006, 6010, 6053, 6054, 6085, 6077, 6118, + 178, 6084, 6089, 6096, 6136, 6146, 173, 166, 6152, 6164, + 6177, 6181, 6183, 6185, 6197, 6201, 6157, 6213, 6225, 6209, + 6130, 9193, 6081, 6110, 0, 6091, 6129, 6142, 6160, 6161, + 6168, 146, 9193, 126, 6169, 6217, 6237, 6241, 6245, 6249, + 6253, 6265, 6261, 6269, 6281, 6287, 6291, 6303, 6315, 6311, + 6254, 9193, 6225, 6248, 6255, 6202, 1153, 69, 1856, 6273, + 6293, 6328, 6332, 6343, 6355, 6371, 6375, 6341, 6388, 6384, + 1880, 6264, 0, 6214, 0, 6277, 6266, 6332, 106, 82, + + 5508, 6432, 6402, 6406, 6410, 6456, 6411, 6392, 9193, 9193, + 6299, 6298, 6360, 6362, 6468, 6512, 6485, 6437, 6359, 6424, + 6251, 6419, 6472, 6497, 6493, 6517, 6536, 6449, 6436, 6370, + 2342, 6540, 6479, 6506, 6310, 6516, 6523, 5963, 6552, 6528, + 6555, 6570, 6573, 6578, 9193, 6557, 6581, 9193, 6560, 6545, + 6591, 6598, 9193, 9193, 6618, 6636, 6654, 6672, 6690, 6707, + 6711, 6729, 6747, 6765, 6781, 6799, 6817, 6835, 6853, 6871, + 6889, 6906, 6923, 6928, 101, 6946, 6964, 6982, 7000, 7018, + 7036, 7054, 7072, 7090, 7108, 7126, 7144, 7162, 7180, 7198, + 7215, 7231, 7236, 7253, 7271, 7289, 7307, 7312, 7330, 7343, + + 7358, 7376, 7394, 7412, 7430, 7448, 7466, 7484, 7500, 7518, + 7536, 7554, 7572, 7590, 7608, 7626, 7644, 7661, 7677, 7694, + 7712, 7730, 7748, 7766, 7771, 7789, 7807, 7825, 7843, 7861, + 7879, 7897, 7915, 7933, 7951, 7969, 7987, 8005, 8023, 8041, + 8059, 8076, 8081, 8097, 8114, 8132, 8150, 8168, 8186, 8204, + 8222, 8240, 8258, 8276, 8294, 8312, 8330, 8348, 8366, 8384, + 8402, 8420, 8438, 8456, 8474, 8492, 8510, 8527, 8545, 8562, + 8578, 8583, 8600, 8618, 8636, 8654, 8672, 8690, 8708, 8726, + 8743, 8760, 8778, 8796, 8814, 8832, 8850, 8868, 8886, 8903, + 8920, 8936, 8953, 8958, 8976, 8994, 9012, 9030, 9048, 9066, + + 9084, 9102, 9120, 9138, 9156, 9174 + } ; + +static yyconst flex_int16_t yy_def[2007] = + { 0, + 1854, 1, 1855, 1855, 1, 1, 1856, 1856, 1855, 1855, + 1854, 11, 1, 1, 1854, 1854, 1854, 1854, 1857, 1858, + 1854, 1854, 1854, 1859, 1860, 1854, 1854, 1854, 1854, 1854, + 1854, 1854, 1854, 1854, 1854, 1854, 1861, 1861, 1861, 1861, + 1861, 1861, 1861, 1861, 1861, 1861, 1861, 1861, 1861, 1861, + 49, 1861, 1861, 1861, 1861, 1861, 1861, 1854, 1854, 1862, + 39, 1861, 1861, 1861, 1861, 1854, 1863, 1854, 1863, 1863, + 1863, 1854, 1854, 1864, 1854, 1865, 1865, 1865, 1865, 79, + 79, 79, 1865, 1865, 79, 79, 79, 79, 1865, 88, + 79, 79, 1865, 89, 1865, 1865, 1854, 58, 1866, 31, + + 1854, 79, 79, 84, 78, 58, 31, 1854, 1854, 1854, + 1867, 1867, 1867, 1868, 1854, 1868, 1868, 1854, 1869, 1870, + 1871, 1870, 1854, 1870, 1870, 1872, 1872, 1854, 1872, 1872, + 1872, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, + 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1873, 1854, 1854, + 1854, 1854, 1854, 1854, 1854, 1874, 1874, 1874, 1874, 1874, + 1874, 1874, 1874, 1874, 1874, 1874, 1874, 1874, 1874, 1874, + 1874, 1874, 1874, 1874, 1874, 1874, 1874, 1874, 1874, 1874, + 1874, 1874, 1874, 1874, 1874, 1874, 1874, 1874, 1874, 1874, + 1874, 1874, 1874, 1874, 1874, 1874, 1874, 1874, 1874, 1874, + + 1874, 1874, 1874, 1874, 1874, 1874, 1874, 1874, 1874, 1874, + 1874, 1874, 1874, 1875, 58, 1854, 1876, 1854, 1854, 1854, + 1854, 1854, 1854, 1877, 1854, 1877, 1877, 1877, 1854, 1874, + 1874, 1874, 1874, 1874, 1874, 1878, 1854, 1878, 1878, 1878, + 1878, 1854, 1879, 1854, 1854, 1854, 1854, 1880, 1881, 1854, + 84, 84, 252, 252, 252, 252, 252, 252, 252, 252, + 252, 252, 252, 252, 252, 252, 252, 252, 252, 252, + 252, 252, 252, 252, 252, 252, 252, 252, 252, 252, + 252, 252, 252, 252, 252, 252, 252, 252, 252, 252, + 252, 252, 252, 252, 252, 252, 252, 252, 252, 252, + + 252, 252, 252, 252, 252, 252, 252, 252, 1854, 1854, + 1854, 1882, 215, 313, 1854, 1883, 1854, 1883, 1883, 1883, + 1854, 1854, 1854, 1854, 1883, 1884, 1884, 327, 327, 327, + 327, 327, 327, 252, 252, 252, 252, 215, 1854, 1854, + 1854, 1854, 1854, 1854, 1885, 1885, 1886, 1886, 1886, 1887, + 1888, 1888, 1888, 1888, 1854, 1889, 1890, 1890, 1854, 1891, + 1854, 1892, 1893, 1892, 1892, 1854, 1854, 1854, 1854, 1854, + 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, + 1854, 1894, 1895, 1854, 1854, 1896, 1854, 1897, 1854, 1854, + 1898, 1898, 1898, 1898, 1898, 1898, 1898, 1898, 1898, 1898, + + 1898, 1898, 1898, 1898, 1898, 1898, 1854, 1898, 1898, 1898, + 1898, 1898, 1898, 1898, 1898, 1898, 1898, 1898, 1898, 1898, + 1898, 1854, 1898, 1854, 1899, 1898, 1898, 1898, 1898, 1898, + 1898, 1898, 1898, 1898, 1898, 1898, 1898, 1898, 1898, 1898, + 1898, 1898, 1898, 1898, 1898, 1898, 1898, 1898, 1898, 1898, + 1898, 1898, 1898, 1898, 1898, 1898, 1898, 1898, 1898, 1898, + 1898, 1898, 1898, 1898, 1898, 1898, 1898, 1898, 1898, 1898, + 1898, 1900, 1854, 1901, 1854, 1854, 1854, 1854, 1854, 1854, + 1902, 1902, 1902, 1854, 1898, 1898, 1898, 1898, 1898, 1898, + 1903, 1903, 1904, 1854, 1854, 1905, 1906, 1854, 1854, 1854, + + 1907, 1908, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, + 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, + 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, + 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, + 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, + 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, + 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, + 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1854, + 1854, 1910, 1854, 1854, 1854, 584, 1854, 1854, 1911, 1911, + 1854, 1854, 1854, 1911, 1912, 1912, 596, 596, 596, 596, + + 596, 596, 596, 1909, 1909, 1909, 1909, 1854, 1854, 1854, + 1854, 1913, 1913, 1914, 1914, 1915, 1916, 1917, 1916, 1916, + 1918, 1918, 1918, 1854, 1854, 1919, 1920, 1920, 1854, 1854, + 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, + 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1921, 1922, + 1854, 1854, 1854, 1923, 1924, 1854, 1925, 1925, 1925, 1925, + 1925, 1925, 1925, 1925, 1925, 1925, 1925, 1925, 1925, 1925, + 1925, 1925, 1925, 1925, 1854, 1925, 1925, 1925, 1854, 1854, + 1925, 1925, 1925, 1925, 1925, 1854, 1854, 1925, 1854, 1854, + 1925, 1925, 1925, 1925, 1925, 1925, 1854, 1854, 1925, 1925, + + 1854, 1925, 1926, 1927, 1928, 1926, 1925, 1925, 1925, 1925, + 1925, 1925, 1925, 1925, 1925, 1925, 1854, 1854, 1925, 1925, + 1925, 1925, 1854, 1854, 1925, 1925, 1925, 1925, 1925, 1925, + 1925, 1925, 1925, 1925, 1925, 1925, 1925, 1925, 1925, 1854, + 1854, 1925, 1925, 1925, 1925, 1925, 1925, 1925, 1925, 1925, + 1925, 1925, 1925, 1925, 1925, 1925, 1925, 1925, 1854, 1854, + 1854, 1854, 1854, 1854, 1854, 1929, 1929, 1929, 1854, 1925, + 1925, 1925, 1925, 1925, 1925, 1930, 1930, 1930, 1854, 1854, + 1854, 1854, 1931, 1932, 1909, 1909, 1909, 1909, 1909, 1909, + 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, + + 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, + 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, + 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, + 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, + 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, + 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, + 1909, 1909, 1909, 1909, 1909, 1909, 1854, 1854, 1854, 1854, + 1854, 1854, 1854, 1933, 1933, 1854, 1933, 1934, 1934, 879, + 879, 879, 879, 879, 879, 879, 879, 879, 1909, 1909, + 1909, 1909, 1854, 1854, 1935, 1936, 1937, 1938, 1939, 1940, + + 1941, 1854, 1854, 1854, 1942, 1943, 1944, 1945, 1946, 1854, + 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1947, 1854, + 1925, 1925, 1925, 1925, 1925, 1948, 1925, 1925, 1925, 1925, + 1925, 1925, 1925, 1925, 1925, 1925, 1925, 1925, 1854, 1925, + 1925, 1854, 1854, 1854, 1854, 1854, 1925, 1925, 1925, 1925, + 1925, 1925, 1925, 1925, 1925, 1854, 1854, 1925, 1854, 1854, + 1925, 1854, 1949, 1950, 1951, 1952, 1925, 1925, 1925, 1925, + 1925, 1925, 1925, 1925, 1925, 1925, 1854, 1854, 1925, 1925, + 1854, 1854, 1854, 1854, 1925, 1925, 1925, 1925, 1925, 1925, + 1925, 1925, 1925, 1925, 1925, 1925, 1854, 1854, 1854, 1854, + + 1925, 1925, 1925, 1925, 1925, 1925, 1925, 1925, 1925, 1854, + 1854, 1925, 1925, 1925, 1854, 1854, 1854, 1854, 1854, 1854, + 1953, 1953, 1954, 1854, 1854, 1925, 1854, 1925, 1925, 1854, + 1854, 1854, 1955, 1955, 1854, 1854, 1854, 1854, 1909, 1909, + 1909, 1909, 1909, 1956, 1909, 1909, 1909, 1909, 1909, 1909, + 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, + 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, + 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, + 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, + 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, + + 1909, 1909, 1909, 1909, 1909, 1854, 1854, 1854, 1854, 1854, + 1854, 1854, 1957, 1958, 1854, 1957, 1957, 1959, 1959, 1119, + 1119, 1119, 1119, 1119, 1119, 1960, 1119, 1909, 1909, 1854, + 1961, 1854, 1962, 1963, 1964, 1965, 1854, 1966, 1967, 1967, + 1854, 1854, 1854, 1968, 1969, 1854, 1970, 1854, 1971, 1971, + 1972, 1854, 1854, 1854, 1854, 1854, 1925, 1925, 1973, 1925, + 1925, 1925, 1925, 1925, 1925, 1925, 1925, 1925, 1925, 1925, + 1925, 1925, 1854, 1854, 1925, 1925, 1854, 1854, 1854, 1854, + 1854, 1925, 1925, 1925, 1925, 1925, 1854, 1854, 1925, 1925, + 1974, 1974, 1975, 1976, 1977, 1976, 1977, 1977, 1925, 1925, + + 1925, 1925, 1925, 1925, 1925, 1854, 1854, 1925, 1925, 1925, + 1925, 1925, 1925, 1925, 1925, 1925, 1925, 1925, 1925, 1925, + 1925, 1925, 1925, 1925, 1925, 1925, 1925, 1925, 1925, 1854, + 1854, 1854, 1854, 1854, 1978, 1979, 1978, 1854, 1925, 1925, + 1925, 1980, 1980, 1854, 1981, 1854, 1854, 1909, 1909, 1982, + 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, + 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, + 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, + 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, + 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, + + 1909, 1854, 1981, 1854, 1983, 1984, 1984, 1985, 1986, 1986, + 1310, 1310, 1310, 1310, 1310, 1909, 1909, 1854, 1854, 1987, + 1988, 1854, 1989, 1989, 1854, 1990, 1854, 1970, 1854, 1971, + 1971, 1972, 1854, 1991, 1854, 1854, 1854, 1854, 1854, 1854, + 1925, 1925, 1925, 1925, 1925, 1925, 1925, 1925, 1925, 1925, + 1925, 1854, 1925, 1925, 1854, 1854, 1925, 1854, 1854, 1854, + 1925, 1925, 1925, 1925, 1854, 1854, 1925, 1925, 1976, 1976, + 1977, 1925, 1925, 1925, 1925, 1925, 1925, 1854, 1854, 1925, + 1854, 1925, 1925, 1925, 1854, 1854, 1925, 1925, 1925, 1925, + 1925, 1925, 1925, 1854, 1925, 1854, 1854, 1854, 1854, 1925, + + 1854, 1854, 1854, 1978, 1978, 1854, 1925, 1854, 1925, 1980, + 1980, 1854, 1854, 1854, 1992, 1909, 1909, 1909, 1909, 1909, + 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, + 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, + 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, + 1909, 1909, 1909, 1909, 1854, 1993, 1854, 1984, 1984, 1310, + 1310, 1310, 1310, 1310, 1310, 1909, 1854, 1854, 1854, 1854, + 1991, 1925, 1925, 1925, 1925, 1925, 1925, 1925, 1925, 1925, + 1854, 1854, 1925, 1925, 1854, 1925, 1854, 1854, 1854, 1925, + 1925, 1925, 1925, 1925, 1976, 1925, 1925, 1925, 1854, 1925, + + 1925, 1925, 1925, 1925, 1925, 1854, 1925, 1925, 1854, 1854, + 1978, 1854, 1925, 1925, 1980, 1980, 1854, 1854, 1994, 1909, + 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, + 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, + 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1854, 1854, 1984, + 1310, 1310, 1310, 1310, 1909, 1854, 1995, 1854, 1854, 1854, + 1996, 1854, 1854, 1925, 1925, 1925, 1925, 1925, 1925, 1925, + 1854, 1854, 1925, 1925, 1854, 1925, 1854, 1854, 1925, 1925, + 1925, 1854, 1854, 1854, 1925, 1925, 1854, 1854, 1925, 1854, + 1925, 1925, 1854, 1854, 1978, 1854, 1925, 1980, 1980, 1854, + + 1994, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, + 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1909, 1854, + 1997, 1984, 1310, 1310, 1909, 1995, 1995, 1995, 1854, 1996, + 1996, 1996, 1925, 1925, 1925, 1925, 1854, 1854, 1925, 1925, + 1854, 1854, 1854, 1854, 1925, 1854, 1925, 1854, 1925, 1925, + 1854, 1978, 1854, 1980, 1980, 1909, 1909, 1909, 1909, 1909, + 1909, 1909, 1909, 1909, 1909, 1997, 1854, 1997, 1997, 1984, + 1310, 1995, 1995, 1998, 1996, 1854, 1996, 1925, 1854, 1854, + 1854, 1854, 1925, 1925, 1925, 1854, 1925, 1854, 1978, 1854, + 1980, 1980, 1909, 1909, 1909, 1909, 1909, 1854, 1854, 1854, + + 1999, 2000, 1997, 1997, 2001, 1984, 1998, 1998, 1998, 1854, + 1854, 1854, 1854, 1925, 1925, 1854, 1925, 1978, 1854, 1980, + 2002, 1909, 1909, 1909, 1854, 1854, 1999, 2000, 1997, 1997, + 1997, 2003, 2004, 2001, 2001, 2001, 1984, 1998, 1995, 1998, + 1854, 1854, 1854, 1854, 1925, 1925, 1854, 1925, 1978, 1854, + 1980, 2002, 1854, 1909, 1909, 1909, 1854, 1854, 1997, 1997, + 2003, 2003, 2003, 2004, 1854, 2004, 2004, 2001, 1997, 2001, + 1984, 1854, 1854, 1925, 1854, 1925, 1978, 1854, 1980, 1909, + 1909, 1854, 1854, 1997, 1997, 2003, 1997, 2003, 2004, 2005, + 1984, 1854, 1925, 1854, 1925, 1978, 1854, 1980, 1909, 1909, + + 1854, 1997, 1997, 1997, 2005, 2005, 2005, 1984, 1854, 1854, + 1978, 1854, 1980, 1854, 1997, 2006, 2005, 2005, 1984, 1978, + 1854, 1980, 1854, 1997, 2001, 1997, 1997, 1984, 1978, 1854, + 1980, 1997, 1984, 1978, 1854, 1980, 1984, 1978, 1854, 1980, + 1984, 1978, 1854, 1854, 1854, 1980, 1984, 1854, 1980, 1980, + 1980, 1980, 1854, 0, 1854, 1854, 1854, 1854, 1854, 1854, + 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, + 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, + 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, + 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, + + 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, + 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, + 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, + 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, + 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, + 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, + 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, + 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, + 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, + 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, + + 1854, 1854, 1854, 1854, 1854, 1854 + } ; + +static yyconst flex_int16_t yy_nxt[9274] = + { 0, + 16, 17, 18, 17, 19, 20, 16, 21, 22, 23, + 24, 25, 26, 27, 26, 28, 26, 29, 30, 31, + 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, + 42, 43, 44, 45, 44, 46, 47, 48, 49, 50, + 51, 44, 52, 53, 54, 55, 44, 56, 44, 44, + 57, 26, 26, 26, 37, 38, 39, 40, 41, 42, + 43, 44, 45, 46, 47, 48, 49, 50, 51, 44, + 52, 53, 54, 55, 44, 56, 44, 44, 57, 16, + 58, 59, 58, 60, 250, 69, 68, 69, 70, 72, + 73, 72, 72, 73, 72, 108, 334, 242, 74, 242, + + 110, 74, 110, 112, 108, 115, 61, 62, 250, 109, + 63, 70, 64, 71, 472, 472, 237, 113, 109, 121, + 108, 240, 1797, 65, 108, 334, 122, 123, 250, 108, + 116, 343, 112, 108, 109, 61, 62, 109, 336, 63, + 70, 64, 71, 109, 117, 113, 109, 124, 1753, 108, + 132, 65, 58, 59, 58, 60, 108, 237, 108, 116, + 343, 125, 109, 108, 151, 345, 336, 108, 1699, 344, + 109, 109, 117, 108, 108, 1699, 124, 109, 61, 62, + 1753, 109, 63, 121, 64, 108, 346, 109, 109, 125, + 122, 123, 108, 241, 345, 65, 108, 344, 109, 110, + + 1699, 110, 108, 108, 313, 109, 314, 61, 62, 109, + 242, 63, 242, 64, 346, 109, 109, 223, 216, 223, + 217, 241, 315, 65, 16, 17, 75, 17, 19, 20, + 16, 21, 22, 23, 24, 25, 26, 27, 26, 28, + 26, 29, 30, 31, 32, 33, 34, 35, 36, 76, + 77, 78, 79, 80, 81, 82, 83, 84, 83, 85, + 86, 87, 88, 89, 90, 83, 91, 92, 93, 94, + 83, 95, 83, 83, 96, 26, 26, 26, 76, 77, + 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, + 88, 89, 90, 83, 91, 92, 93, 94, 83, 95, + + 83, 83, 96, 16, 58, 97, 98, 60, 152, 118, + 118, 118, 119, 115, 1699, 108, 99, 321, 389, 322, + 389, 586, 100, 390, 250, 155, 126, 393, 126, 109, + 101, 102, 108, 348, 103, 323, 104, 587, 108, 127, + 338, 127, 338, 128, 108, 369, 109, 105, 118, 118, + 118, 119, 109, 115, 158, 130, 393, 109, 339, 101, + 102, 108, 348, 103, 340, 104, 340, 108, 161, 131, + 250, 656, 370, 369, 109, 105, 106, 59, 106, 60, + 109, 250, 341, 158, 130, 250, 397, 142, 143, 142, + 349, 870, 399, 342, 107, 144, 161, 131, 145, 148, + + 370, 149, 61, 62, 146, 377, 63, 871, 64, 147, + 150, 150, 108, 153, 154, 397, 108, 121, 349, 65, + 108, 399, 342, 150, 122, 123, 109, 202, 158, 250, + 109, 61, 62, 377, 109, 63, 121, 64, 403, 150, + 150, 108, 161, 122, 123, 108, 803, 65, 133, 108, + 133, 150, 157, 250, 109, 158, 202, 158, 109, 357, + 214, 159, 109, 1025, 378, 1025, 134, 403, 160, 161, + 161, 394, 135, 158, 162, 371, 136, 108, 137, 158, + 158, 157, 182, 138, 158, 139, 140, 161, 357, 159, + 372, 109, 378, 161, 161, 141, 160, 161, 359, 394, + + 359, 135, 158, 162, 371, 136, 108, 137, 158, 158, + 182, 138, 360, 139, 140, 161, 395, 411, 372, 109, + 436, 161, 161, 141, 163, 158, 168, 158, 187, 158, + 169, 164, 188, 158, 114, 165, 170, 1137, 166, 161, + 225, 161, 189, 161, 395, 226, 411, 161, 167, 436, + 396, 250, 398, 163, 158, 168, 158, 187, 158, 169, + 164, 188, 158, 165, 170, 183, 166, 161, 227, 161, + 189, 161, 184, 185, 186, 161, 167, 158, 396, 161, + 398, 400, 228, 171, 225, 172, 173, 406, 174, 175, + 229, 161, 410, 1690, 183, 176, 453, 227, 656, 464, + + 184, 185, 186, 1027, 250, 1027, 158, 161, 230, 400, + 228, 171, 158, 172, 173, 406, 174, 175, 412, 161, + 410, 190, 231, 176, 158, 453, 161, 177, 464, 250, + 178, 179, 126, 180, 126, 1511, 373, 230, 161, 181, + 250, 158, 375, 191, 466, 127, 412, 127, 158, 190, + 231, 374, 376, 158, 161, 192, 177, 193, 178, 179, + 158, 180, 161, 194, 198, 373, 161, 181, 195, 413, + 196, 375, 191, 466, 161, 197, 156, 158, 199, 374, + 376, 200, 467, 192, 201, 193, 1027, 250, 1027, 158, + 161, 194, 250, 198, 250, 414, 195, 413, 196, 352, + + 353, 352, 161, 197, 156, 250, 199, 354, 355, 200, + 203, 467, 201, 208, 204, 158, 134, 257, 158, 158, + 209, 212, 253, 414, 205, 368, 368, 158, 250, 206, + 207, 213, 161, 161, 417, 210, 256, 418, 368, 203, + 211, 161, 208, 204, 158, 250, 257, 158, 158, 209, + 212, 253, 205, 250, 368, 368, 158, 206, 207, 213, + 161, 161, 417, 210, 256, 418, 368, 419, 211, 161, + 215, 216, 215, 217, 232, 158, 250, 420, 168, 158, + 250, 233, 169, 321, 182, 588, 401, 402, 170, 161, + 238, 237, 238, 161, 468, 419, 218, 219, 237, 108, + + 220, 587, 221, 232, 158, 420, 317, 168, 158, 233, + 250, 169, 182, 222, 401, 402, 170, 161, 239, 250, + 1854, 161, 1854, 468, 250, 218, 219, 208, 108, 220, + 183, 221, 158, 1854, 209, 1854, 250, 184, 234, 186, + 471, 222, 421, 250, 161, 426, 161, 239, 434, 1515, + 250, 235, 245, 246, 247, 248, 208, 1550, 391, 183, + 250, 158, 250, 209, 249, 184, 234, 186, 252, 471, + 421, 253, 161, 426, 161, 392, 434, 254, 249, 235, + 250, 621, 251, 621, 255, 256, 251, 391, 253, 263, + 253, 317, 277, 264, 622, 435, 622, 252, 439, 265, + + 253, 121, 256, 392, 256, 254, 225, 249, 122, 123, + 317, 251, 255, 256, 250, 251, 477, 253, 263, 253, + 277, 318, 264, 435, 251, 283, 439, 265, 282, 251, + 256, 404, 256, 250, 251, 284, 405, 258, 319, 251, + 225, 358, 253, 272, 259, 477, 273, 274, 260, 275, + 250, 261, 320, 251, 283, 276, 256, 282, 251, 415, + 404, 262, 251, 284, 250, 405, 258, 319, 251, 358, + 416, 253, 272, 259, 273, 274, 260, 275, 278, 261, + 320, 317, 484, 276, 256, 279, 280, 281, 415, 262, + 251, 1689, 256, 440, 251, 225, 441, 266, 416, 267, + + 268, 442, 269, 270, 437, 237, 251, 278, 443, 271, + 251, 484, 438, 279, 280, 281, 285, 446, 481, 251, + 256, 440, 250, 251, 441, 266, 250, 267, 268, 442, + 269, 270, 1706, 437, 286, 251, 443, 271, 251, 251, + 438, 422, 251, 422, 285, 446, 287, 481, 288, 459, + 253, 142, 143, 142, 289, 460, 1720, 461, 290, 144, + 291, 293, 297, 286, 256, 292, 251, 251, 146, 465, + 630, 251, 251, 251, 287, 294, 288, 459, 295, 253, + 250, 296, 289, 460, 423, 461, 290, 250, 291, 444, + 293, 297, 256, 292, 298, 251, 250, 465, 299, 630, + + 251, 251, 251, 294, 445, 633, 295, 478, 300, 296, + 303, 250, 423, 301, 302, 253, 250, 304, 444, 305, + 250, 251, 451, 298, 306, 250, 251, 299, 452, 256, + 479, 251, 445, 214, 633, 478, 300, 250, 631, 303, + 631, 301, 302, 632, 253, 407, 304, 305, 253, 251, + 307, 451, 306, 253, 251, 225, 452, 256, 479, 1025, + 308, 1025, 256, 309, 310, 311, 312, 256, 384, 385, + 384, 386, 401, 486, 251, 249, 144, 253, 251, 307, + 447, 335, 253, 448, 277, 146, 408, 409, 308, 249, + 256, 223, 216, 223, 217, 256, 223, 216, 223, 217, + + 401, 486, 494, 251, 494, 248, 1796, 251, 447, 335, + 114, 448, 277, 1322, 408, 409, 250, 250, 249, 316, + 316, 324, 316, 316, 316, 316, 325, 316, 316, 316, + 316, 316, 316, 316, 316, 316, 316, 316, 326, 316, + 316, 316, 316, 316, 327, 326, 326, 326, 326, 328, + 326, 329, 326, 326, 326, 330, 326, 326, 331, 326, + 326, 326, 326, 332, 326, 326, 326, 326, 333, 326, + 316, 316, 326, 327, 326, 326, 326, 326, 328, 326, + 329, 326, 326, 330, 326, 326, 331, 326, 326, 326, + 326, 332, 326, 326, 326, 326, 333, 326, 316, 303, + + 657, 359, 424, 359, 424, 494, 304, 495, 248, 487, + 251, 250, 425, 251, 1854, 360, 1854, 361, 359, 362, + 359, 469, 250, 337, 225, 470, 393, 1512, 303, 657, + 388, 1854, 360, 1854, 361, 304, 362, 487, 251, 150, + 150, 251, 364, 359, 133, 359, 133, 482, 225, 658, + 469, 337, 150, 363, 470, 393, 1854, 360, 1854, 361, + 625, 362, 379, 380, 381, 382, 488, 356, 150, 150, + 363, 364, 366, 449, 383, 148, 482, 149, 658, 661, + 150, 367, 353, 450, 365, 490, 150, 150, 383, 616, + 355, 141, 1854, 427, 488, 363, 431, 432, 610, 150, + + 347, 366, 449, 433, 225, 428, 473, 429, 661, 367, + 430, 450, 365, 490, 115, 150, 150, 383, 454, 141, + 455, 1854, 427, 237, 431, 432, 610, 150, 462, 475, + 317, 433, 344, 428, 473, 429, 456, 457, 430, 480, + 458, 398, 463, 476, 483, 396, 611, 454, 485, 455, + 223, 216, 223, 217, 238, 237, 238, 462, 475, 241, + 344, 237, 237, 427, 456, 457, 317, 480, 458, 398, + 463, 476, 483, 396, 611, 428, 485, 429, 1627, 612, + 489, 1628, 239, 505, 491, 251, 317, 241, 492, 589, + 317, 115, 427, 613, 245, 246, 247, 248, 498, 499, + + 500, 501, 251, 428, 250, 429, 249, 612, 489, 594, + 502, 239, 505, 491, 251, 629, 250, 492, 589, 251, + 249, 613, 614, 251, 502, 250, 251, 251, 251, 424, + 251, 424, 506, 251, 503, 317, 250, 251, 594, 425, + 251, 251, 509, 629, 251, 251, 251, 251, 251, 249, + 614, 504, 251, 502, 251, 251, 251, 507, 251, 251, + 506, 251, 508, 503, 251, 511, 251, 251, 251, 250, + 251, 509, 251, 251, 251, 590, 251, 644, 515, 504, + 251, 251, 251, 250, 251, 507, 251, 251, 646, 510, + 508, 251, 251, 512, 511, 251, 251, 251, 251, 530, + + 115, 513, 514, 590, 407, 644, 673, 515, 251, 251, + 251, 251, 251, 516, 251, 251, 646, 510, 517, 250, + 251, 512, 251, 251, 518, 251, 251, 530, 251, 513, + 514, 251, 251, 251, 522, 673, 251, 659, 521, 251, + 615, 251, 516, 251, 251, 519, 520, 517, 660, 250, + 251, 251, 518, 584, 251, 584, 523, 251, 251, 251, + 251, 662, 251, 522, 251, 659, 521, 251, 615, 663, + 251, 251, 524, 519, 520, 250, 660, 251, 251, 525, + 225, 251, 585, 251, 523, 251, 251, 251, 251, 662, + 664, 526, 674, 251, 251, 529, 528, 663, 343, 251, + + 524, 225, 527, 531, 251, 251, 251, 525, 251, 251, + 665, 585, 609, 422, 251, 422, 251, 251, 664, 532, + 526, 674, 251, 529, 528, 251, 424, 343, 424, 251, + 527, 531, 251, 251, 1369, 704, 425, 251, 665, 251, + 609, 625, 534, 535, 705, 706, 251, 532, 356, 338, + 505, 338, 251, 251, 666, 536, 533, 537, 251, 347, + 538, 580, 216, 580, 312, 115, 317, 339, 251, 251, + 534, 671, 535, 647, 251, 647, 382, 251, 251, 505, + 250, 251, 666, 536, 533, 537, 539, 540, 538, 542, + 902, 251, 902, 541, 251, 251, 251, 251, 250, 671, + + 544, 903, 543, 352, 353, 352, 251, 251, 251, 251, + 545, 354, 355, 251, 539, 540, 677, 542, 546, 672, + 251, 541, 251, 251, 250, 251, 251, 251, 250, 544, + 543, 251, 251, 251, 251, 251, 251, 547, 251, 545, + 548, 251, 550, 549, 251, 677, 546, 672, 251, 251, + 251, 554, 251, 569, 251, 696, 251, 251, 237, 250, + 251, 251, 251, 251, 251, 547, 551, 251, 548, 552, + 550, 549, 251, 250, 251, 251, 251, 251, 251, 554, + 251, 569, 317, 696, 553, 647, 251, 648, 382, 699, + 555, 702, 251, 556, 551, 250, 251, 251, 552, 251, + + 250, 678, 251, 557, 251, 559, 561, 251, 591, 1798, + 591, 560, 553, 558, 251, 353, 251, 699, 555, 702, + 251, 556, 616, 355, 251, 688, 251, 562, 251, 563, + 678, 251, 557, 1808, 559, 561, 251, 585, 251, 560, + 251, 558, 251, 694, 251, 564, 565, 568, 251, 566, + 567, 570, 251, 251, 688, 251, 562, 604, 563, 250, + 251, 572, 251, 250, 225, 571, 585, 251, 508, 251, + 251, 251, 694, 564, 565, 568, 251, 566, 567, 251, + 570, 695, 251, 251, 667, 604, 573, 668, 251, 251, + 572, 251, 251, 571, 574, 575, 508, 920, 251, 707, + + 251, 340, 251, 340, 576, 1627, 251, 251, 1628, 251, + 695, 251, 667, 577, 573, 668, 251, 578, 251, 251, + 1027, 251, 1027, 574, 575, 700, 251, 707, 251, 1152, + 608, 251, 579, 576, 251, 1143, 686, 251, 686, 591, + 251, 592, 577, 251, 250, 353, 578, 251, 309, 310, + 311, 312, 616, 355, 700, 251, 251, 587, 687, 608, + 249, 579, 580, 216, 581, 312, 250, 321, 585, 588, + 597, 251, 121, 598, 249, 498, 499, 500, 501, 122, + 123, 326, 708, 148, 326, 593, 326, 502, 326, 599, + 709, 326, 710, 326, 150, 150, 713, 585, 326, 597, + + 714, 502, 598, 249, 602, 326, 619, 150, 250, 326, + 708, 321, 326, 872, 326, 250, 326, 599, 709, 326, + 710, 326, 250, 150, 150, 713, 326, 250, 714, 871, + 502, 250, 602, 326, 619, 150, 316, 316, 324, 316, + 316, 316, 316, 316, 316, 316, 316, 316, 316, 316, + 316, 316, 316, 316, 316, 603, 316, 316, 316, 316, + 316, 326, 600, 601, 326, 251, 535, 1627, 326, 669, + 1628, 326, 692, 693, 715, 716, 250, 605, 536, 720, + 537, 726, 251, 606, 603, 727, 670, 316, 316, 326, + 600, 601, 326, 250, 251, 535, 326, 499, 669, 326, + + 692, 693, 715, 499, 716, 605, 536, 720, 537, 726, + 251, 606, 964, 727, 670, 316, 316, 316, 324, 316, + 316, 316, 316, 316, 316, 316, 316, 316, 316, 316, + 316, 316, 316, 316, 316, 963, 316, 316, 316, 316, + 316, 251, 340, 676, 340, 340, 675, 340, 352, 353, + 352, 728, 595, 697, 607, 697, 354, 355, 251, 596, + 339, 148, 717, 341, 717, 656, 920, 316, 316, 121, + 251, 608, 150, 150, 608, 698, 122, 123, 380, 728, + 595, 634, 607, 634, 718, 150, 251, 596, 380, 719, + 359, 359, 359, 359, 641, 316, 641, 635, 711, 914, + + 608, 150, 150, 608, 360, 360, 361, 361, 624, 362, + 642, 712, 620, 150, 359, 359, 359, 359, 719, 913, + 911, 721, 722, 723, 725, 723, 636, 711, 360, 360, + 361, 361, 362, 362, 643, 379, 380, 381, 382, 712, + 620, 910, 363, 363, 237, 724, 422, 383, 422, 627, + 721, 722, 632, 725, 636, 384, 385, 384, 386, 628, + 731, 383, 643, 144, 388, 407, 363, 363, 651, 652, + 653, 654, 146, 368, 368, 407, 144, 627, 729, 730, + 383, 675, 689, 732, 689, 146, 368, 628, 731, 701, + 383, 676, 733, 736, 383, 1836, 737, 734, 744, 745, + + 746, 738, 368, 368, 690, 735, 407, 729, 730, 739, + 747, 732, 748, 740, 368, 740, 408, 701, 691, 632, + 753, 733, 736, 383, 737, 734, 744, 745, 749, 746, + 738, 750, 751, 735, 407, 741, 752, 739, 754, 747, + 755, 748, 756, 757, 408, 679, 691, 679, 742, 753, + 758, 480, 760, 761, 762, 763, 749, 743, 764, 750, + 751, 765, 225, 225, 752, 225, 754, 680, 755, 769, + 756, 757, 681, 770, 772, 773, 742, 682, 758, 480, + 760, 761, 762, 763, 774, 743, 764, 683, 684, 765, + 250, 685, 766, 669, 775, 250, 767, 712, 769, 237, + + 123, 681, 770, 772, 773, 583, 682, 250, 768, 779, + 771, 779, 248, 774, 250, 683, 684, 785, 250, 685, + 250, 766, 669, 775, 767, 712, 786, 250, 776, 777, + 237, 777, 779, 250, 780, 248, 768, 781, 771, 781, + 501, 498, 499, 500, 501, 781, 785, 782, 501, 250, + 790, 788, 787, 502, 792, 786, 250, 776, 789, 250, + 250, 778, 250, 250, 250, 250, 791, 502, 250, 250, + 407, 686, 250, 686, 250, 250, 250, 250, 790, 788, + 787, 250, 792, 250, 797, 801, 803, 789, 869, 793, + 778, 802, 250, 687, 791, 795, 502, 794, 796, 799, + + 820, 798, 800, 805, 250, 804, 811, 1025, 821, 1025, + 250, 519, 250, 797, 801, 499, 869, 793, 813, 814, + 802, 250, 250, 795, 817, 794, 796, 799, 820, 798, + 800, 815, 805, 250, 804, 811, 821, 816, 250, 519, + 679, 250, 679, 689, 250, 689, 813, 814, 697, 250, + 697, 250, 817, 250, 250, 634, 818, 634, 819, 250, + 815, 250, 680, 250, 829, 690, 816, 806, 250, 250, + 698, 635, 807, 250, 250, 499, 717, 250, 717, 812, + 250, 823, 808, 809, 818, 822, 810, 819, 827, 250, + 825, 250, 829, 250, 828, 830, 806, 824, 718, 831, + + 833, 807, 832, 826, 723, 250, 723, 812, 250, 823, + 808, 809, 250, 822, 810, 250, 834, 827, 835, 825, + 837, 841, 828, 250, 830, 824, 724, 836, 831, 833, + 832, 826, 250, 250, 250, 840, 250, 250, 250, 250, + 250, 250, 250, 250, 838, 834, 839, 835, 837, 841, + 246, 246, 250, 250, 244, 836, 740, 250, 740, 842, + 250, 250, 250, 843, 840, 846, 848, 225, 847, 844, + 854, 759, 838, 250, 849, 839, 250, 845, 741, 862, + 852, 853, 857, 858, 250, 250, 865, 842, 855, 856, + 390, 850, 843, 860, 846, 848, 847, 844, 859, 854, + + 851, 390, 849, 317, 317, 845, 656, 862, 852, 853, + 857, 858, 380, 861, 865, 863, 864, 855, 856, 850, + 317, 860, 867, 216, 867, 312, 859, 866, 851, 867, + 216, 868, 312, 309, 310, 311, 312, 874, 591, 591, + 873, 591, 861, 863, 864, 249, 380, 875, 591, 877, + 873, 326, 250, 250, 609, 866, 871, 645, 880, 249, + 640, 915, 121, 915, 382, 874, 871, 585, 585, 122, + 123, 326, 639, 638, 326, 875, 889, 585, 877, 892, + 326, 888, 609, 321, 881, 872, 880, 121, 249, 584, + 216, 584, 217, 326, 1140, 1141, 585, 585, 326, 148, + + 326, 876, 250, 326, 895, 889, 585, 882, 892, 888, + 150, 150, 881, 893, 887, 218, 219, 326, 585, 220, + 897, 221, 326, 150, 894, 883, 890, 326, 884, 896, + 637, 912, 473, 895, 115, 882, 1027, 625, 1027, 150, + 150, 893, 887, 123, 218, 219, 326, 585, 220, 897, + 221, 150, 894, 883, 115, 890, 884, 896, 899, 912, + 473, 316, 316, 324, 316, 316, 316, 316, 316, 316, + 316, 316, 316, 316, 316, 316, 316, 316, 316, 316, + 617, 316, 316, 316, 316, 316, 885, 899, 326, 621, + 921, 621, 898, 118, 1854, 922, 1854, 878, 121, 923, + + 924, 115, 622, 886, 622, 122, 123, 1854, 359, 1854, + 359, 317, 316, 316, 359, 885, 359, 326, 921, 902, + 898, 902, 360, 922, 317, 878, 625, 923, 360, 924, + 903, 886, 1854, 250, 1854, 904, 583, 905, 927, 900, + 316, 316, 316, 324, 316, 316, 316, 316, 316, 316, + 316, 316, 316, 316, 316, 316, 316, 316, 316, 316, + 891, 316, 316, 316, 316, 316, 927, 900, 121, 704, + 879, 906, 321, 826, 321, 122, 123, 246, 705, 706, + 359, 641, 359, 641, 246, 925, 359, 926, 359, 891, + 930, 493, 316, 316, 360, 901, 928, 642, 624, 879, + + 360, 826, 361, 359, 362, 359, 634, 641, 634, 641, + 915, 929, 916, 382, 925, 931, 926, 360, 930, 361, + 316, 362, 635, 642, 901, 928, 932, 244, 908, 933, + 934, 909, 363, 917, 385, 917, 654, 939, 363, 939, + 929, 144, 935, 931, 948, 651, 652, 653, 654, 949, + 146, 936, 937, 144, 932, 363, 908, 383, 933, 934, + 909, 938, 146, 951, 917, 385, 918, 654, 947, 940, + 935, 383, 144, 948, 384, 385, 384, 386, 949, 936, + 937, 146, 144, 941, 686, 950, 686, 952, 689, 938, + 689, 146, 951, 953, 954, 955, 947, 956, 940, 956, + + 383, 958, 697, 959, 697, 959, 687, 961, 962, 968, + 690, 941, 679, 950, 679, 952, 965, 704, 965, 957, + 967, 953, 954, 955, 698, 960, 705, 706, 969, 966, + 958, 966, 970, 973, 680, 961, 962, 968, 966, 942, + 971, 237, 974, 975, 943, 976, 225, 972, 979, 967, + 980, 986, 987, 225, 944, 945, 969, 977, 946, 977, + 356, 970, 973, 717, 988, 717, 118, 989, 942, 971, + 974, 990, 975, 943, 976, 972, 991, 979, 980, 978, + 986, 987, 944, 945, 992, 718, 946, 981, 983, 981, + 983, 723, 988, 723, 966, 989, 993, 994, 347, 995, + + 990, 996, 115, 1001, 991, 997, 740, 997, 740, 982, + 984, 1002, 992, 724, 999, 998, 999, 1003, 1004, 1005, + 1006, 225, 1007, 985, 993, 1008, 994, 995, 741, 1009, + 996, 1001, 1010, 1012, 1010, 1013, 1000, 1014, 1015, 1002, + 1016, 1017, 1018, 1019, 1020, 1003, 1004, 225, 1005, 1006, + 1007, 985, 225, 1008, 1011, 1024, 1028, 1026, 1009, 237, + 244, 1021, 1012, 250, 1013, 933, 1014, 1015, 1016, 237, + 1017, 1018, 1019, 1020, 777, 237, 777, 250, 237, 1023, + 971, 250, 1030, 1024, 1030, 1028, 1026, 972, 1022, 1021, + 250, 1029, 1031, 250, 933, 1035, 1032, 1035, 248, 1033, + + 1035, 1032, 1036, 248, 1039, 1034, 778, 250, 1023, 971, + 1037, 250, 1037, 501, 1040, 972, 1022, 250, 1037, 1029, + 1038, 501, 1041, 250, 250, 250, 250, 1033, 250, 250, + 1048, 1045, 1039, 1034, 1044, 778, 1042, 250, 250, 250, + 250, 250, 1040, 250, 250, 250, 1043, 1046, 250, 250, + 1041, 250, 1047, 250, 250, 1052, 1854, 1049, 1048, 1045, + 1051, 250, 1108, 1044, 250, 1042, 939, 250, 939, 1050, + 250, 1053, 1060, 250, 1055, 1043, 1046, 1056, 1059, 1063, + 1061, 1047, 1054, 68, 1052, 1049, 1065, 1062, 250, 1051, + 1108, 1854, 1064, 1066, 1067, 250, 250, 1050, 1057, 1053, + + 1068, 1060, 1055, 1069, 1070, 1056, 1059, 1071, 1063, 1061, + 1054, 250, 1058, 250, 1065, 1062, 956, 250, 956, 250, + 1064, 1066, 1067, 959, 250, 959, 1073, 1057, 250, 1068, + 1072, 1069, 1077, 1070, 1079, 1071, 250, 250, 957, 250, + 1058, 250, 1074, 250, 250, 960, 977, 250, 977, 1075, + 1076, 1854, 981, 250, 981, 1073, 250, 1078, 1072, 1854, + 1077, 1080, 250, 1079, 1084, 983, 250, 983, 978, 250, + 1087, 1074, 250, 1081, 982, 1083, 250, 1075, 1085, 1076, + 250, 250, 997, 250, 997, 250, 1078, 984, 250, 250, + 1080, 1086, 998, 1084, 999, 250, 999, 250, 250, 1087, + + 1082, 1081, 1092, 1091, 1083, 250, 1085, 250, 250, 250, + 1854, 1088, 1093, 250, 1089, 1854, 1000, 1130, 1090, 1086, + 1854, 1854, 1095, 1098, 250, 1094, 1854, 250, 1082, 1096, + 1092, 1157, 1091, 1097, 1099, 1102, 1010, 250, 1010, 1088, + 1103, 1093, 1089, 317, 1101, 1130, 1090, 316, 1100, 316, + 1095, 1104, 1098, 1094, 1105, 317, 1854, 1096, 1011, 1157, + 321, 1097, 1111, 1099, 1102, 1106, 216, 1106, 312, 1103, + 1114, 1119, 1101, 1854, 1854, 591, 1100, 1112, 1110, 591, + 1104, 1112, 317, 1105, 1106, 216, 1107, 312, 584, 216, + 1109, 217, 316, 1110, 316, 1158, 1113, 1110, 1854, 1114, + + 1119, 1131, 250, 316, 585, 316, 1110, 316, 585, 316, + 316, 321, 316, 1111, 218, 219, 1854, 585, 220, 1133, + 221, 1854, 1116, 1158, 1113, 1128, 359, 148, 359, 1115, + 1131, 473, 1854, 585, 1118, 1120, 1854, 585, 150, 150, + 360, 1121, 1159, 218, 219, 1122, 585, 220, 1133, 221, + 1116, 150, 1854, 115, 1128, 316, 1854, 316, 1153, 473, + 1153, 382, 1118, 1153, 1120, 1154, 382, 150, 150, 1121, + 1854, 1159, 1244, 1122, 1244, 248, 250, 1135, 1854, 150, + 316, 316, 324, 316, 316, 316, 316, 316, 316, 316, + 316, 316, 316, 316, 316, 316, 316, 316, 316, 1123, + + 316, 316, 316, 316, 316, 1074, 1135, 1155, 385, 1155, + 654, 1161, 1075, 1160, 1164, 144, 1129, 1163, 1165, 1030, + 250, 1030, 1166, 1172, 146, 1167, 316, 1123, 316, 1031, + 1854, 316, 316, 1032, 1074, 1032, 1854, 1032, 1032, 1161, + 1075, 1854, 1160, 1164, 1129, 1163, 1165, 1854, 121, 1032, + 1124, 1166, 1172, 1167, 1032, 1324, 1325, 1168, 1125, 316, + 316, 1117, 324, 1117, 316, 316, 316, 316, 316, 316, + 316, 316, 316, 316, 316, 316, 316, 316, 316, 1124, + 316, 316, 316, 316, 316, 1168, 316, 1125, 316, 316, + 1854, 316, 121, 1187, 1408, 1187, 1408, 1169, 1854, 122, + + 123, 1854, 902, 1170, 902, 902, 1171, 902, 359, 1175, + 359, 316, 316, 903, 1126, 1188, 903, 1127, 904, 1138, + 1142, 904, 360, 905, 361, 1169, 362, 1155, 385, 1156, + 654, 1170, 704, 1176, 1171, 144, 1145, 1854, 1175, 316, + 1177, 1196, 1197, 1126, 146, 997, 1127, 997, 1138, 1230, + 1244, 1230, 1245, 248, 906, 998, 1412, 906, 1412, 1231, + 363, 939, 1176, 939, 1854, 1145, 1132, 1146, 1177, 1146, + 1132, 1132, 1132, 1132, 1132, 1132, 1132, 1132, 1132, 1132, + 1132, 1147, 1132, 1148, 1132, 1149, 1132, 1132, 1132, 1132, + 1132, 1854, 1178, 1173, 651, 652, 653, 654, 1179, 1854, + + 1180, 1181, 144, 1182, 1183, 1184, 383, 1174, 1185, 1186, + 1190, 146, 1189, 1199, 956, 1200, 956, 1132, 1132, 1151, + 383, 1178, 1173, 1202, 959, 1854, 959, 1179, 1180, 1854, + 1181, 1182, 1183, 1854, 1184, 1174, 957, 1185, 1186, 1190, + 1189, 1201, 1199, 1854, 1200, 1132, 960, 1854, 1854, 383, + 1132, 1132, 1202, 1132, 1132, 1132, 1132, 1132, 1132, 1132, + 1132, 1132, 1132, 1132, 1132, 1132, 1132, 1132, 1132, 1201, + 1132, 1132, 1132, 1132, 1132, 1191, 1193, 1191, 1193, 1203, + 1117, 317, 1117, 1204, 1205, 1854, 963, 964, 1192, 1194, + 1192, 1194, 1208, 965, 704, 965, 1209, 1192, 1194, 1210, + + 704, 1132, 1132, 705, 706, 1211, 966, 1203, 966, 1196, + 1197, 1204, 1198, 1205, 1198, 966, 1206, 977, 1206, 977, + 1208, 1198, 981, 1214, 981, 1209, 1212, 1213, 1210, 1132, + 983, 1215, 983, 1216, 1211, 1217, 1854, 1218, 1207, 978, + 1219, 1220, 1854, 1224, 982, 999, 1221, 999, 1222, 225, + 1223, 1214, 984, 1192, 1194, 1212, 1213, 1225, 1226, 1232, + 1215, 1227, 1216, 1228, 1217, 1218, 1229, 1000, 1233, 1219, + 1220, 966, 1224, 1010, 1221, 1010, 1222, 1198, 1223, 1234, + 1235, 225, 1030, 1238, 1030, 1225, 1239, 1226, 1232, 1227, + 1240, 1228, 1031, 1241, 1229, 1011, 1032, 1233, 237, 237, + + 1030, 1032, 1030, 1246, 250, 1246, 501, 1234, 1236, 1235, + 1031, 250, 1238, 250, 1032, 1239, 250, 250, 1240, 1032, + 326, 1246, 1241, 1247, 501, 250, 1187, 250, 1187, 1242, + 1206, 250, 1206, 1854, 1854, 1304, 1251, 1236, 326, 1318, + 1854, 1243, 250, 1250, 1337, 1248, 1337, 1249, 1188, 326, + 1255, 1854, 1207, 1252, 1230, 250, 1230, 1854, 1242, 1302, + 216, 1302, 312, 1304, 1231, 1251, 1338, 326, 1318, 1243, + 250, 250, 1250, 1248, 250, 1249, 250, 250, 250, 1255, + 1254, 1252, 1132, 1132, 250, 1132, 1132, 1132, 1132, 1132, + 1132, 1132, 1132, 1132, 1132, 1132, 1132, 1132, 1132, 1132, + + 1132, 1257, 1132, 1132, 1132, 1132, 1132, 1256, 1254, 250, + 1258, 250, 1259, 250, 1260, 250, 250, 250, 250, 1262, + 250, 250, 250, 250, 250, 250, 250, 250, 1854, 250, + 1257, 250, 250, 1132, 1132, 1256, 250, 250, 1258, 1264, + 1259, 1269, 1260, 1261, 1263, 1265, 1854, 1262, 1268, 250, + 1266, 1267, 1270, 1272, 1273, 1854, 1271, 1274, 250, 1276, + 1281, 1132, 1278, 250, 1275, 1279, 250, 1277, 1264, 1280, + 1269, 1261, 250, 1263, 1265, 250, 1282, 1268, 1266, 1267, + 250, 1270, 1272, 1273, 1271, 1287, 1274, 250, 1276, 1281, + 1278, 1284, 1275, 1288, 1279, 1277, 250, 1280, 250, 250, + + 250, 1285, 250, 1283, 250, 1282, 250, 250, 250, 250, + 250, 359, 250, 359, 1287, 902, 1286, 902, 1289, 1344, + 1284, 1291, 1288, 1854, 1292, 360, 903, 326, 1296, 1230, + 1285, 1230, 1283, 1313, 591, 1298, 591, 317, 1290, 1231, + 317, 1293, 1295, 591, 1286, 591, 1294, 1289, 1344, 1297, + 1291, 1299, 1300, 1292, 1301, 1854, 326, 1296, 1302, 216, + 1303, 312, 1313, 585, 1298, 326, 1290, 1305, 1307, 1293, + 1295, 326, 585, 1311, 1294, 250, 1310, 1297, 1854, 1299, + 1300, 1854, 1301, 584, 216, 584, 217, 250, 1412, 321, + 1412, 321, 585, 326, 326, 326, 1305, 1307, 1854, 1854, + + 326, 585, 1311, 1317, 1310, 148, 1314, 149, 1312, 218, + 219, 121, 585, 220, 1349, 221, 150, 150, 122, 123, + 121, 1316, 326, 1342, 326, 1854, 473, 122, 123, 150, + 1854, 1468, 1317, 1468, 1314, 621, 1312, 621, 218, 219, + 1854, 585, 220, 1349, 221, 150, 150, 1854, 622, 1316, + 622, 1342, 1854, 1333, 473, 1333, 382, 150, 316, 316, + 324, 316, 316, 316, 316, 316, 316, 316, 316, 316, + 316, 316, 316, 316, 316, 316, 316, 1854, 316, 316, + 316, 316, 316, 902, 902, 902, 902, 1308, 1333, 1343, + 1334, 382, 1345, 1351, 903, 903, 1339, 1414, 1339, 1414, + + 501, 1142, 1143, 1346, 1347, 359, 1348, 359, 1350, 316, + 316, 359, 359, 359, 359, 1854, 1308, 1343, 1340, 360, + 1345, 361, 1351, 624, 1854, 360, 360, 361, 361, 362, + 362, 1346, 1347, 1854, 1348, 906, 1350, 316, 316, 316, + 324, 316, 316, 316, 316, 316, 316, 316, 316, 316, + 316, 316, 316, 316, 316, 316, 316, 363, 316, 316, + 316, 316, 316, 363, 363, 1309, 1335, 385, 1335, 654, + 1335, 385, 1336, 654, 144, 1355, 1356, 1357, 144, 1358, + 1359, 1360, 1854, 146, 1363, 1361, 1362, 146, 1364, 316, + 316, 963, 1854, 1192, 1309, 1192, 1414, 1854, 1415, 501, + + 1854, 1468, 1192, 1468, 1355, 1356, 1357, 1358, 1359, 1854, + 1360, 1352, 1363, 1352, 1361, 1362, 1364, 316, 1306, 1306, + 324, 1306, 1306, 1306, 1306, 1306, 1306, 1306, 1306, 1306, + 1306, 1306, 1306, 1306, 1306, 1306, 1306, 1353, 1306, 1306, + 1306, 1306, 1306, 1365, 1367, 1365, 1187, 1368, 1187, 1191, + 1354, 1191, 1375, 1372, 1854, 1373, 1374, 1387, 1192, 1376, + 963, 1193, 1192, 1193, 1192, 1366, 1353, 1377, 1188, 1306, + 1306, 1192, 964, 1367, 1194, 1368, 1194, 1369, 1354, 1370, + 1375, 1370, 1372, 1194, 1373, 1374, 1387, 1376, 1370, 1455, + 216, 1455, 217, 1854, 1391, 1377, 1380, 1306, 1319, 1327, + + 1393, 1327, 1319, 1319, 1319, 1319, 1319, 1319, 1319, 1319, + 1319, 1319, 1319, 1328, 1319, 1329, 1319, 1330, 1319, 1319, + 1319, 1319, 1319, 1391, 1380, 1383, 1206, 1192, 1206, 1393, + 1371, 704, 1371, 1384, 1388, 1378, 1381, 1378, 1381, 1194, + 1196, 1197, 1389, 1198, 1370, 1198, 704, 1401, 1207, 1319, + 1319, 1332, 1198, 1383, 1854, 1196, 1197, 1379, 1198, 1854, + 1198, 1384, 1388, 1455, 216, 1455, 1456, 1198, 1854, 1390, + 1389, 1408, 250, 1408, 1854, 1382, 1401, 1319, 1319, 1319, + 1854, 1319, 1319, 1319, 1319, 1319, 1319, 1319, 1319, 1319, + 1319, 1319, 1319, 1319, 1319, 1319, 1319, 1390, 1319, 1319, + + 1319, 1319, 1319, 1382, 1385, 1392, 1385, 237, 1198, 1394, + 1396, 1394, 1396, 1400, 1398, 1402, 1398, 1403, 1854, 225, + 1406, 250, 1407, 1198, 1409, 250, 1386, 237, 250, 1319, + 1319, 1854, 1397, 1392, 1411, 1395, 1399, 1337, 250, 1337, + 1457, 1400, 1474, 1402, 1419, 1854, 1403, 1404, 250, 1406, + 1407, 1434, 1429, 1409, 902, 1410, 902, 1319, 250, 1338, + 1339, 250, 1339, 1411, 1395, 903, 1854, 1854, 250, 1457, + 250, 1474, 250, 1419, 250, 250, 1404, 1854, 1854, 250, + 1434, 1429, 1340, 1418, 1410, 1319, 1319, 250, 1319, 1319, + 1319, 1319, 1319, 1319, 1319, 1319, 1319, 1319, 1319, 1319, + + 1319, 1319, 1319, 1319, 1421, 1319, 1319, 1319, 1319, 1319, + 1417, 1418, 1420, 250, 1422, 1423, 250, 1425, 250, 1432, + 1352, 250, 1352, 250, 250, 250, 250, 1365, 250, 1365, + 250, 250, 1421, 250, 250, 250, 1319, 1319, 1417, 250, + 1420, 1424, 1422, 1423, 1426, 1425, 1427, 1432, 250, 1366, + 1430, 1431, 1381, 250, 1381, 1435, 1436, 1437, 250, 1428, + 1433, 1438, 250, 250, 1319, 250, 250, 1378, 250, 1378, + 1424, 1439, 250, 1426, 1440, 1427, 250, 1441, 317, 1430, + 1431, 1447, 1442, 1435, 1475, 1436, 1437, 1428, 1433, 1379, + 1438, 1443, 1385, 250, 1385, 1446, 250, 250, 1448, 1439, + + 1449, 1451, 1440, 1444, 1854, 1441, 1459, 1452, 1854, 1447, + 1442, 1854, 1445, 1475, 1386, 1394, 250, 1394, 1462, 1443, + 1396, 250, 1396, 1450, 1446, 1463, 1448, 1464, 1449, 1451, + 1465, 1444, 1398, 250, 1398, 1459, 1452, 1467, 250, 1454, + 1445, 1453, 1397, 121, 1854, 359, 1462, 359, 1854, 121, + 122, 123, 1450, 1463, 1399, 1464, 122, 123, 1465, 360, + 1408, 1466, 1408, 1854, 1408, 1467, 1408, 1454, 1476, 1854, + 1453, 1458, 1458, 324, 1458, 1458, 1458, 1458, 1458, 1458, + 1458, 1458, 1458, 1458, 1458, 1458, 1458, 1458, 1458, 1458, + 1466, 1458, 1458, 1458, 1458, 1458, 621, 1476, 621, 1470, + + 385, 1470, 654, 1480, 1477, 1854, 1337, 144, 1337, 622, + 1518, 622, 1518, 1339, 1854, 1339, 146, 1478, 359, 1479, + 359, 1483, 1458, 1458, 359, 359, 359, 359, 1338, 1854, + 1854, 1480, 360, 1477, 361, 1340, 624, 1854, 360, 360, + 361, 361, 362, 362, 1854, 1518, 1478, 1518, 1479, 1483, + 1458, 316, 316, 324, 316, 316, 316, 316, 316, 316, + 316, 316, 316, 316, 316, 316, 316, 316, 316, 316, + 363, 316, 316, 316, 316, 316, 363, 363, 1484, 1470, + 385, 1471, 654, 1485, 1472, 1854, 1486, 144, 1473, 1487, + 1488, 1854, 1489, 1490, 1667, 1461, 146, 1493, 1491, 1492, + + 1854, 1668, 316, 316, 1669, 1854, 1484, 1365, 1517, 1365, + 1517, 248, 1485, 1472, 1486, 1854, 1854, 1473, 1487, 1488, + 1489, 1854, 1490, 1461, 1352, 1493, 1352, 1491, 1492, 1366, + 316, 316, 316, 324, 316, 316, 316, 316, 316, 316, + 316, 316, 316, 316, 316, 316, 316, 316, 316, 316, + 1481, 316, 316, 316, 316, 316, 1494, 1369, 1495, 1370, + 1495, 1370, 1854, 1482, 1496, 1497, 1498, 1503, 1370, 1369, + 1500, 1370, 1381, 1370, 1381, 1371, 704, 1371, 1501, 1481, + 1370, 1854, 316, 316, 1494, 1196, 1197, 1378, 1198, 1378, + 1198, 1482, 1496, 1507, 1497, 1498, 1503, 1198, 1500, 1385, + + 1502, 1385, 1504, 1505, 1508, 1396, 1501, 1396, 1510, 1379, + 316, 1499, 1394, 1398, 1394, 1398, 1509, 1513, 1514, 237, + 250, 1386, 1507, 250, 1370, 250, 250, 1397, 1502, 250, + 1504, 1505, 250, 1508, 250, 1399, 1370, 1510, 1506, 1499, + 250, 250, 250, 1527, 1509, 1513, 1520, 1514, 250, 250, + 1521, 1523, 1522, 1198, 250, 250, 1524, 250, 250, 1516, + 250, 1525, 250, 250, 250, 250, 1535, 1506, 1526, 250, + 250, 250, 1527, 1549, 1854, 1520, 250, 1528, 1854, 1521, + 1523, 1522, 1530, 1532, 1533, 1524, 1529, 1516, 1531, 1534, + 1525, 1536, 1551, 1539, 1535, 1553, 1537, 1526, 250, 1542, + + 1538, 1549, 1541, 250, 1540, 1528, 1544, 1547, 250, 1814, + 1530, 1814, 1532, 1533, 1529, 1545, 1531, 1552, 1534, 1536, + 1554, 1551, 1539, 1553, 1537, 1543, 1546, 1542, 1854, 1538, + 1541, 1564, 1540, 1555, 1544, 1565, 1547, 1548, 216, 1548, + 312, 1566, 1556, 1545, 1556, 1558, 1552, 1558, 382, 1554, + 1854, 1854, 1557, 1567, 1543, 1546, 1559, 143, 1559, 1568, + 1564, 1569, 1555, 1565, 144, 1574, 1560, 385, 1560, 386, + 1566, 1570, 1571, 146, 144, 1572, 1560, 385, 1560, 1561, + 1573, 1567, 1575, 146, 1562, 1576, 1577, 1568, 1578, 1569, + 1579, 1580, 1581, 1563, 1574, 1584, 1854, 1585, 1854, 1570, + + 1571, 1586, 1591, 1572, 1582, 1587, 1582, 1587, 1573, 1495, + 1575, 1495, 1589, 1590, 1576, 1577, 1592, 1578, 1579, 1580, + 1369, 1581, 1370, 1584, 1370, 1585, 1583, 1588, 1593, 1586, + 1591, 1370, 1594, 225, 1596, 1597, 250, 250, 237, 237, + 250, 1589, 1590, 1517, 1592, 1517, 248, 1600, 250, 1600, + 501, 250, 250, 1854, 250, 250, 1593, 250, 250, 1595, + 1602, 1594, 250, 1596, 1597, 1598, 250, 1599, 250, 250, + 250, 1623, 250, 1603, 317, 1604, 1854, 1614, 250, 1854, + 1605, 1582, 250, 1582, 250, 1610, 1854, 1370, 1595, 1602, + 1606, 1608, 1609, 1607, 1598, 1611, 1599, 1854, 1613, 1623, + + 1622, 1603, 1619, 1583, 1604, 1617, 1614, 1615, 1605, 1854, + 1854, 1612, 1616, 1854, 1610, 1587, 250, 1587, 1606, 1608, + 1609, 1607, 1624, 1854, 1611, 1618, 1613, 250, 1854, 1622, + 1619, 1559, 1854, 1559, 1617, 1615, 1620, 1588, 1620, 1612, + 1616, 1548, 216, 1548, 312, 1556, 1621, 1556, 146, 1558, + 1624, 1558, 382, 1618, 1625, 1557, 1629, 385, 1629, 654, + 1630, 385, 1630, 1636, 144, 1633, 1634, 1638, 1631, 1635, + 1637, 1639, 1640, 146, 1559, 143, 1559, 1632, 384, 385, + 384, 386, 144, 1625, 1641, 1645, 144, 1644, 1646, 1647, + 1649, 146, 1636, 1633, 1634, 146, 1638, 1635, 1637, 1639, + + 1642, 1640, 1642, 1582, 1587, 1582, 1587, 1648, 1650, 1651, + 1643, 225, 1653, 1641, 1645, 1644, 1646, 237, 1647, 1649, + 237, 1600, 250, 1600, 501, 1583, 1588, 250, 250, 250, + 250, 317, 1671, 250, 250, 1648, 250, 1650, 1651, 1620, + 1653, 1620, 1854, 1655, 1642, 250, 1642, 250, 1652, 1621, + 250, 1681, 1854, 1654, 1643, 1683, 1656, 1659, 1661, 1662, + 1671, 1663, 1854, 1629, 385, 1629, 654, 1660, 1670, 1657, + 1658, 144, 1655, 1854, 1664, 1678, 1652, 1665, 1854, 1681, + 146, 1654, 1854, 1683, 1656, 1682, 1659, 1661, 1662, 1854, + 1663, 1672, 1673, 1672, 1674, 1660, 1670, 1657, 1658, 1627, + + 1684, 250, 1628, 1664, 1678, 1685, 1665, 1630, 656, 1630, + 1675, 1676, 1675, 1677, 1682, 1679, 1686, 1679, 1631, 1687, + 1642, 1642, 1642, 1642, 1632, 1680, 1688, 1632, 237, 1684, + 1643, 1643, 237, 250, 1685, 1694, 1679, 250, 1679, 250, + 250, 250, 1667, 1667, 1854, 1686, 1680, 1713, 1687, 1668, + 1668, 1673, 1669, 1669, 1691, 1688, 1854, 1692, 1708, 1712, + 1693, 1709, 1714, 1694, 1842, 1843, 1842, 1696, 1697, 1854, + 1695, 1854, 1698, 1699, 1700, 1701, 1713, 1703, 1704, 1703, + 1705, 225, 1854, 1691, 1702, 1668, 1692, 1712, 1669, 1693, + 1854, 1714, 1672, 1673, 1672, 1674, 1696, 1697, 1702, 1695, + + 1627, 1715, 1716, 1628, 1672, 1673, 1672, 1674, 1675, 1676, + 1675, 1677, 1627, 1717, 237, 1628, 1631, 1718, 651, 652, + 653, 654, 1679, 1719, 1679, 1632, 144, 1702, 250, 1715, + 383, 1716, 1680, 250, 1710, 146, 1710, 250, 1743, 317, + 1854, 1721, 1717, 1746, 383, 1718, 1854, 1711, 1744, 1711, + 1725, 1719, 1725, 1701, 1745, 1722, 1711, 1698, 1699, 1700, + 1701, 1704, 1725, 1724, 1726, 1701, 1854, 1743, 1735, 1702, + 1721, 1736, 1746, 383, 1723, 1737, 1744, 1703, 1704, 1703, + 1705, 1747, 1745, 1702, 1722, 1668, 250, 225, 1669, 1854, + 1673, 250, 1724, 1729, 1730, 1731, 1732, 1708, 250, 1748, + + 1709, 1668, 1723, 1737, 1669, 1733, 1738, 1739, 1738, 1740, + 1747, 1673, 1702, 1710, 1708, 1710, 1750, 1709, 1708, 1733, + 237, 1709, 1755, 1741, 1749, 1741, 1711, 1748, 1711, 1772, + 1774, 1741, 1754, 1741, 1742, 1711, 1711, 1757, 1711, 1757, + 1701, 1756, 1742, 1773, 1750, 1711, 1751, 1757, 1733, 1758, + 1701, 1755, 1749, 1759, 1704, 1759, 1732, 1772, 1774, 317, + 1754, 1668, 225, 1854, 1669, 1729, 1730, 1731, 1732, 1756, + 237, 250, 1773, 1668, 1775, 1751, 1669, 1733, 1759, 1704, + 1760, 1732, 1854, 1730, 1776, 1765, 1668, 1704, 1854, 1669, + 1762, 1733, 1766, 1763, 1735, 1767, 1771, 1736, 1768, 1769, + + 1768, 1770, 1775, 1704, 1777, 1778, 1735, 1779, 1780, 1736, + 1735, 1673, 1776, 1736, 1738, 1739, 1738, 1740, 1708, 250, + 1733, 1709, 1708, 1854, 1771, 1709, 1672, 1673, 1672, 1674, + 1854, 1795, 1777, 1778, 1627, 1779, 1780, 1628, 1782, 1854, + 1782, 1701, 1782, 1810, 1783, 1701, 1784, 1704, 1784, 1732, + 1784, 1704, 1785, 1732, 1668, 1730, 317, 1669, 1668, 1781, + 1795, 1669, 1762, 1730, 1792, 1763, 1786, 1787, 1786, 1788, + 1762, 1765, 1810, 1763, 1762, 250, 1854, 1763, 1766, 225, + 1830, 1767, 1698, 1699, 1700, 1701, 1793, 1781, 1789, 1730, + 1789, 1790, 1792, 1765, 1702, 250, 1766, 1794, 1791, 1767, + + 1766, 225, 1809, 1767, 1768, 1769, 1768, 1770, 1702, 1830, + 1812, 1799, 1735, 1704, 1793, 1736, 1729, 1730, 1731, 1732, + 1735, 1811, 1800, 1736, 1668, 1794, 1791, 1669, 1733, 1801, + 1809, 1801, 1701, 1801, 237, 1802, 1701, 1702, 1812, 1799, + 1821, 1820, 1733, 1730, 1803, 1704, 1803, 1732, 1854, 1811, + 1762, 1800, 1668, 1763, 1839, 1669, 1803, 1704, 1804, 1732, + 1854, 317, 237, 1823, 1668, 1823, 1701, 1669, 1821, 1820, + 1813, 1733, 1786, 1787, 1786, 1788, 1729, 1730, 1731, 1732, + 1762, 1854, 1839, 1763, 1668, 1854, 1730, 1669, 1733, 1789, + 1730, 1789, 1790, 1806, 317, 1835, 1807, 1766, 1813, 1822, + + 1767, 1828, 1733, 1815, 1704, 1815, 1732, 1815, 1704, 1816, + 1732, 1668, 1730, 1730, 1669, 1668, 1854, 1854, 1669, 1806, + 1806, 237, 1807, 1807, 1835, 1854, 225, 1822, 1854, 1828, + 1854, 1733, 1854, 1814, 1854, 1814, 1819, 1854, 225, 1730, + 1854, 1854, 1854, 1854, 1854, 1854, 1806, 1854, 1854, 1807, + 1854, 317, 1854, 1829, 1854, 1854, 1854, 1817, 1787, 1817, + 1818, 1834, 1854, 1831, 1819, 1806, 1854, 1854, 1807, 1824, + 1704, 1824, 1705, 1823, 1854, 1823, 1701, 1668, 1833, 1854, + 1669, 317, 1829, 1854, 1854, 1854, 1817, 1787, 1817, 1818, + 1834, 1831, 1854, 1854, 1806, 1704, 1854, 1807, 1832, 1704, + + 1832, 1732, 1735, 1854, 1837, 1736, 1668, 1833, 225, 1669, + 1854, 1854, 1666, 1824, 1704, 1824, 1825, 1666, 237, 1667, + 1666, 1827, 1666, 1666, 1669, 317, 1668, 1666, 1666, 1669, + 237, 1854, 1666, 1837, 1666, 1666, 1666, 1703, 1704, 1703, + 1705, 1832, 1704, 1832, 1732, 1668, 1854, 237, 1669, 1668, + 1838, 1854, 1669, 1844, 1845, 1844, 1847, 1848, 1847, 237, + 1840, 1854, 237, 1666, 1666, 1666, 1854, 1841, 1854, 1854, + 1846, 1842, 1843, 1842, 223, 216, 223, 217, 1838, 1844, + 1845, 1844, 1847, 1848, 1847, 1850, 1849, 1854, 1840, 1851, + 1854, 1666, 1852, 1853, 1852, 1841, 1854, 1854, 1846, 1852, + + 1853, 1852, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, + 1854, 1854, 1854, 1854, 1850, 1849, 1854, 1851, 66, 66, + 66, 66, 66, 66, 66, 66, 66, 66, 66, 66, + 66, 66, 66, 66, 66, 66, 67, 67, 67, 67, + 67, 67, 67, 67, 67, 67, 67, 67, 67, 67, + 67, 67, 67, 67, 111, 111, 1854, 111, 111, 111, + 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, + 111, 111, 114, 114, 114, 114, 114, 114, 114, 114, + 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, + 120, 120, 120, 120, 120, 120, 120, 120, 120, 120, + + 120, 120, 120, 120, 120, 120, 120, 120, 129, 1854, + 1854, 1854, 1854, 1854, 1854, 129, 1854, 129, 1854, 129, + 129, 129, 129, 129, 156, 156, 156, 156, 156, 224, + 224, 224, 224, 224, 224, 224, 224, 224, 224, 224, + 224, 224, 224, 224, 224, 224, 224, 236, 236, 236, + 236, 236, 236, 236, 236, 236, 236, 236, 236, 236, + 236, 236, 236, 236, 236, 243, 243, 243, 243, 243, + 243, 243, 243, 243, 243, 243, 243, 243, 243, 243, + 243, 243, 243, 251, 1854, 1854, 1854, 1854, 1854, 1854, + 1854, 1854, 1854, 1854, 251, 251, 251, 251, 251, 316, + + 316, 316, 316, 316, 316, 316, 316, 316, 316, 316, + 316, 316, 316, 316, 316, 316, 316, 111, 111, 1854, + 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, + 111, 111, 111, 111, 111, 114, 114, 114, 114, 114, + 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, + 114, 114, 114, 350, 350, 350, 350, 350, 350, 350, + 350, 350, 350, 350, 350, 350, 350, 350, 350, 350, + 350, 120, 120, 120, 120, 120, 120, 120, 120, 120, + 120, 120, 120, 120, 120, 120, 120, 120, 120, 351, + 351, 351, 351, 351, 351, 351, 351, 351, 351, 351, + + 351, 351, 351, 351, 351, 351, 351, 129, 1854, 1854, + 1854, 1854, 1854, 1854, 129, 1854, 129, 1854, 1854, 129, + 129, 129, 129, 387, 387, 387, 387, 1854, 387, 387, + 387, 387, 387, 387, 1854, 387, 387, 1854, 1854, 387, + 387, 156, 156, 156, 156, 156, 474, 474, 474, 474, + 474, 474, 474, 474, 474, 474, 474, 474, 474, 474, + 474, 474, 474, 474, 224, 224, 224, 224, 224, 224, + 224, 224, 224, 224, 224, 224, 224, 224, 224, 224, + 224, 224, 236, 236, 236, 236, 236, 236, 236, 236, + 236, 236, 236, 236, 236, 236, 236, 236, 236, 236, + + 243, 243, 243, 243, 243, 243, 243, 243, 243, 243, + 243, 243, 243, 243, 243, 243, 243, 243, 496, 496, + 496, 496, 496, 496, 496, 496, 496, 496, 496, 496, + 496, 496, 496, 496, 496, 496, 497, 497, 497, 497, + 497, 497, 497, 497, 497, 497, 497, 497, 497, 497, + 497, 497, 497, 497, 582, 582, 582, 582, 582, 582, + 582, 582, 582, 582, 582, 582, 582, 582, 582, 582, + 582, 582, 316, 316, 316, 316, 316, 316, 316, 316, + 316, 316, 316, 316, 316, 316, 316, 316, 316, 316, + 326, 326, 326, 326, 326, 326, 326, 326, 326, 326, + + 326, 326, 326, 326, 326, 326, 326, 326, 111, 111, + 1854, 111, 111, 111, 111, 111, 111, 111, 111, 111, + 111, 111, 111, 111, 111, 111, 114, 114, 114, 114, + 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, + 114, 114, 114, 114, 350, 350, 350, 350, 350, 350, + 350, 350, 350, 350, 350, 350, 350, 350, 350, 350, + 350, 350, 351, 351, 351, 351, 351, 351, 351, 351, + 351, 351, 351, 351, 351, 351, 351, 351, 351, 351, + 618, 618, 618, 618, 618, 618, 618, 618, 618, 618, + 618, 618, 618, 618, 618, 618, 618, 618, 120, 120, + + 120, 120, 120, 120, 120, 120, 120, 120, 120, 120, + 120, 120, 120, 120, 120, 120, 623, 1854, 1854, 1854, + 1854, 1854, 1854, 623, 1854, 623, 1854, 1854, 623, 623, + 623, 623, 129, 1854, 1854, 1854, 1854, 1854, 1854, 1854, + 129, 1854, 129, 1854, 129, 129, 129, 129, 129, 626, + 626, 626, 626, 649, 649, 649, 649, 649, 649, 649, + 649, 649, 649, 649, 649, 649, 649, 649, 649, 649, + 649, 650, 650, 650, 650, 650, 650, 650, 650, 650, + 650, 650, 650, 650, 650, 650, 650, 650, 650, 655, + 655, 655, 655, 655, 655, 655, 655, 655, 655, 655, + + 655, 655, 655, 655, 655, 655, 655, 387, 387, 387, + 387, 1854, 387, 387, 387, 387, 387, 387, 1854, 387, + 387, 1854, 1854, 387, 387, 156, 156, 156, 156, 156, + 703, 703, 703, 703, 703, 703, 703, 703, 703, 703, + 703, 703, 703, 703, 703, 703, 703, 703, 472, 1854, + 1854, 1854, 1854, 1854, 1854, 1854, 472, 472, 474, 474, + 474, 474, 474, 474, 474, 474, 474, 474, 474, 474, + 474, 474, 474, 474, 474, 474, 224, 224, 224, 224, + 224, 224, 224, 224, 224, 224, 224, 224, 224, 224, + 224, 224, 224, 224, 236, 236, 236, 236, 236, 236, + + 236, 236, 236, 236, 236, 236, 236, 236, 236, 236, + 236, 236, 243, 243, 243, 243, 243, 243, 243, 243, + 243, 243, 243, 243, 243, 243, 243, 243, 243, 243, + 496, 496, 496, 496, 496, 496, 496, 496, 496, 496, + 496, 496, 496, 496, 496, 496, 496, 496, 497, 497, + 497, 497, 497, 497, 497, 497, 497, 497, 497, 497, + 497, 497, 497, 497, 497, 497, 783, 783, 783, 783, + 783, 783, 783, 783, 783, 783, 783, 783, 783, 783, + 783, 783, 783, 783, 784, 784, 784, 784, 784, 784, + 784, 784, 784, 784, 784, 784, 784, 784, 784, 784, + + 784, 784, 251, 1854, 1854, 1854, 1854, 1854, 1854, 1854, + 1854, 1854, 1854, 251, 251, 251, 251, 251, 582, 582, + 582, 582, 582, 582, 582, 582, 582, 582, 582, 582, + 582, 582, 582, 582, 582, 582, 316, 316, 316, 316, + 316, 316, 316, 316, 316, 316, 316, 316, 316, 316, + 316, 316, 316, 316, 326, 326, 326, 326, 326, 326, + 326, 326, 326, 326, 326, 326, 326, 326, 326, 326, + 326, 326, 111, 111, 1854, 111, 111, 111, 111, 111, + 111, 111, 111, 111, 111, 111, 111, 111, 111, 111, + 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, + + 114, 114, 114, 114, 114, 114, 114, 114, 351, 351, + 351, 351, 351, 351, 351, 351, 351, 351, 351, 351, + 351, 351, 351, 351, 351, 351, 120, 120, 120, 120, + 120, 120, 120, 120, 120, 120, 120, 120, 120, 120, + 120, 120, 120, 120, 618, 618, 618, 618, 618, 618, + 618, 618, 618, 618, 618, 618, 618, 618, 618, 618, + 618, 618, 623, 1854, 1854, 1854, 1854, 1854, 1854, 623, + 1854, 623, 1854, 1854, 623, 623, 623, 623, 907, 1854, + 1854, 1854, 1854, 1854, 1854, 1854, 907, 1854, 1854, 1854, + 907, 907, 907, 907, 907, 129, 1854, 1854, 1854, 1854, + + 1854, 1854, 1854, 129, 1854, 129, 1854, 129, 129, 129, + 129, 129, 649, 649, 649, 649, 649, 649, 649, 649, + 649, 649, 649, 649, 649, 649, 649, 649, 649, 649, + 650, 650, 650, 650, 650, 650, 650, 650, 650, 650, + 650, 650, 650, 650, 650, 650, 650, 650, 919, 919, + 919, 919, 919, 919, 919, 919, 919, 919, 919, 919, + 919, 919, 919, 919, 919, 919, 655, 655, 655, 655, + 655, 655, 655, 655, 655, 655, 655, 655, 655, 655, + 655, 655, 655, 655, 156, 156, 156, 156, 156, 703, + 703, 703, 703, 703, 703, 703, 703, 703, 703, 703, + + 703, 703, 703, 703, 703, 703, 703, 704, 704, 704, + 704, 704, 704, 1854, 704, 704, 704, 704, 704, 704, + 704, 704, 704, 704, 704, 705, 705, 1854, 705, 705, + 705, 705, 705, 705, 705, 705, 705, 705, 705, 705, + 705, 705, 705, 224, 224, 224, 224, 224, 224, 224, + 224, 224, 224, 224, 224, 224, 224, 224, 224, 224, + 224, 236, 236, 236, 236, 236, 236, 236, 236, 236, + 236, 236, 236, 236, 236, 236, 236, 236, 236, 783, + 783, 783, 783, 783, 783, 783, 783, 783, 783, 783, + 783, 783, 783, 783, 783, 783, 783, 784, 784, 784, + + 784, 784, 784, 784, 784, 784, 784, 784, 784, 784, + 784, 784, 784, 784, 784, 316, 316, 316, 316, 316, + 316, 316, 316, 316, 316, 316, 316, 316, 316, 316, + 316, 316, 316, 326, 326, 326, 326, 326, 326, 326, + 326, 326, 326, 326, 326, 326, 326, 326, 326, 326, + 326, 1132, 1132, 1854, 1132, 1132, 1132, 1132, 1132, 1132, + 1132, 1132, 1132, 1132, 1132, 1132, 1132, 1132, 1132, 111, + 111, 1854, 111, 111, 111, 111, 111, 111, 111, 111, + 111, 111, 111, 111, 111, 111, 111, 1134, 1134, 1854, + 1134, 1134, 1134, 1134, 1134, 1134, 1134, 1134, 1134, 1134, + + 1134, 1134, 1134, 1134, 1134, 114, 114, 114, 114, 114, + 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, + 114, 114, 114, 1136, 1136, 1136, 1136, 1136, 1136, 1136, + 1136, 1136, 1136, 1136, 1136, 1136, 1136, 1136, 1136, 1136, + 1136, 120, 120, 120, 120, 120, 120, 120, 120, 120, + 120, 120, 120, 120, 120, 120, 120, 120, 120, 1139, + 1139, 1139, 1139, 1139, 1139, 1139, 1139, 1139, 1139, 1139, + 1139, 1139, 1139, 1139, 1139, 1139, 1139, 623, 1854, 1854, + 1854, 1854, 1854, 623, 1854, 1854, 1854, 623, 1854, 623, + 623, 623, 623, 623, 1144, 1144, 1144, 1144, 907, 1854, + + 1854, 1854, 1854, 1854, 1854, 1854, 907, 1854, 1854, 1854, + 907, 907, 907, 907, 907, 129, 1854, 1854, 1854, 1854, + 1854, 1854, 1854, 129, 1854, 129, 1854, 129, 129, 129, + 129, 129, 1150, 1150, 1854, 1150, 1150, 1150, 1150, 1150, + 1150, 1150, 1150, 1150, 1150, 1150, 1150, 1150, 1150, 1150, + 919, 919, 919, 919, 919, 919, 919, 919, 919, 919, + 919, 919, 919, 919, 919, 919, 919, 919, 1162, 1162, + 1854, 1162, 1162, 1162, 1162, 1162, 1162, 1162, 1162, 1162, + 1162, 1162, 1162, 1162, 1162, 1162, 704, 704, 704, 704, + 704, 704, 1854, 704, 704, 704, 704, 704, 704, 704, + + 704, 704, 704, 704, 705, 705, 1854, 705, 705, 705, + 705, 705, 705, 705, 705, 705, 705, 705, 705, 705, + 705, 705, 703, 703, 703, 703, 703, 703, 703, 703, + 703, 703, 703, 703, 703, 703, 703, 703, 703, 703, + 1195, 1195, 1195, 1195, 1195, 1195, 1195, 1195, 1195, 1195, + 1195, 1195, 1195, 1195, 1195, 1195, 1195, 1195, 224, 224, + 224, 224, 224, 224, 224, 224, 224, 224, 224, 224, + 224, 224, 224, 224, 224, 224, 1237, 1237, 1237, 1237, + 1237, 1237, 1237, 1237, 1237, 1237, 1237, 1237, 1237, 1237, + 1237, 1237, 1237, 1237, 236, 236, 236, 236, 236, 236, + + 236, 236, 236, 236, 236, 236, 236, 236, 236, 236, + 236, 236, 1253, 1253, 1253, 1253, 1253, 1253, 1253, 1253, + 1253, 1253, 1253, 1253, 1253, 1253, 1253, 1253, 1253, 1253, + 316, 316, 316, 316, 316, 316, 316, 316, 316, 316, + 316, 316, 316, 316, 316, 316, 316, 316, 1306, 1306, + 1306, 1306, 1306, 1306, 1306, 1306, 1306, 1306, 1306, 1306, + 1306, 1306, 1306, 1306, 1306, 1306, 326, 326, 326, 326, + 326, 326, 326, 326, 326, 326, 326, 326, 326, 326, + 326, 326, 326, 326, 1315, 1315, 1315, 1315, 1315, 1315, + 1315, 1315, 1315, 1315, 1315, 1315, 1315, 1315, 1315, 1315, + + 1315, 1315, 1319, 1319, 1854, 1319, 1319, 1319, 1319, 1319, + 1319, 1319, 1319, 1319, 1319, 1319, 1319, 1319, 1319, 1319, + 1320, 1320, 1854, 1320, 1320, 1320, 1320, 1320, 1320, 1320, + 1320, 1320, 1320, 1320, 1320, 1320, 1320, 1320, 111, 111, + 1854, 111, 111, 111, 111, 111, 111, 111, 111, 111, + 111, 111, 111, 111, 111, 111, 1321, 1321, 1321, 1321, + 1321, 1321, 1321, 1321, 1321, 1321, 1321, 1321, 1321, 1321, + 1321, 1321, 1321, 1321, 114, 114, 114, 114, 114, 114, + 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, + 114, 114, 1323, 1323, 1323, 1323, 1323, 1323, 1323, 1323, + + 1323, 1323, 1323, 1323, 1323, 1323, 1323, 1323, 1323, 1323, + 120, 120, 120, 120, 120, 120, 120, 120, 120, 120, + 120, 120, 120, 120, 120, 120, 120, 120, 1326, 1854, + 1854, 1854, 1854, 1854, 1326, 1854, 1854, 1854, 1854, 1854, + 1326, 1326, 1326, 1326, 1326, 1331, 1331, 1854, 1331, 1331, + 1331, 1331, 1331, 1331, 1331, 1331, 1331, 1331, 1331, 1331, + 1331, 1331, 1331, 623, 1854, 1854, 1854, 1854, 1854, 1854, + 623, 1854, 623, 1854, 1854, 623, 623, 623, 623, 129, + 1854, 1854, 1854, 1854, 1854, 1854, 1854, 129, 1854, 129, + 1854, 129, 129, 129, 129, 129, 626, 626, 626, 626, + + 1341, 1341, 1854, 1341, 1341, 1341, 1341, 1341, 1341, 1341, + 1341, 1341, 1341, 1341, 1341, 1341, 1341, 1341, 704, 704, + 704, 704, 704, 704, 1854, 704, 704, 704, 704, 704, + 704, 704, 704, 704, 704, 704, 705, 705, 1854, 705, + 705, 705, 705, 705, 705, 705, 705, 705, 705, 705, + 705, 705, 705, 705, 1196, 1196, 1854, 1196, 1196, 1196, + 1196, 1196, 1196, 1196, 1196, 1196, 1196, 1196, 1196, 1196, + 1196, 1196, 1195, 1195, 1195, 1195, 1195, 1195, 1195, 1195, + 1195, 1195, 1195, 1195, 1195, 1195, 1195, 1195, 1195, 1195, + 224, 224, 224, 224, 224, 224, 224, 224, 224, 224, + + 224, 224, 224, 224, 224, 224, 224, 224, 1405, 1405, + 1405, 1405, 1405, 1405, 1405, 1405, 1405, 1405, 1405, 1405, + 1405, 1405, 1405, 1405, 1405, 1405, 236, 236, 236, 236, + 236, 236, 236, 236, 236, 236, 236, 236, 236, 236, + 236, 236, 236, 236, 1413, 1854, 1413, 1854, 1854, 1854, + 1854, 1413, 1854, 1854, 1413, 1413, 1413, 1413, 1413, 1413, + 1416, 1416, 1416, 1416, 1416, 1416, 1416, 1416, 1416, 1416, + 1416, 1416, 1416, 1416, 1416, 1416, 1416, 1416, 1458, 1458, + 1458, 1458, 1458, 1458, 1458, 1458, 1458, 1458, 1458, 1458, + 1458, 1458, 1458, 1458, 1458, 1458, 316, 316, 316, 316, + + 316, 316, 316, 316, 316, 316, 316, 316, 316, 316, + 316, 316, 316, 316, 1460, 1460, 1460, 1460, 1460, 1460, + 1460, 1460, 1460, 1460, 1460, 1460, 1460, 1460, 1460, 1460, + 1460, 1460, 326, 326, 326, 326, 326, 326, 326, 326, + 326, 326, 326, 326, 326, 326, 326, 326, 326, 326, + 111, 111, 1854, 111, 111, 111, 111, 111, 111, 111, + 111, 111, 111, 111, 111, 111, 111, 111, 114, 114, + 114, 114, 114, 114, 114, 114, 114, 114, 114, 114, + 114, 114, 114, 114, 114, 114, 120, 120, 120, 120, + 120, 120, 120, 120, 120, 120, 120, 120, 120, 120, + + 120, 120, 120, 120, 1326, 1854, 1854, 1854, 1854, 1854, + 1326, 1854, 1854, 1854, 1854, 1854, 1326, 1326, 1326, 1326, + 1326, 1469, 1854, 1469, 1854, 1854, 1854, 1854, 1469, 1854, + 1854, 1469, 1469, 1469, 1469, 1469, 1469, 1519, 1854, 1519, + 1854, 1854, 1854, 1854, 1519, 1854, 1854, 1519, 1519, 1519, + 1519, 1519, 1519, 474, 474, 474, 474, 474, 474, 474, + 474, 474, 474, 474, 474, 474, 474, 474, 474, 474, + 474, 1601, 1601, 1601, 1601, 1601, 1626, 1626, 1854, 1626, + 1626, 1626, 1626, 1626, 1626, 1626, 1626, 1626, 1626, 1626, + 1626, 1626, 1626, 1626, 655, 655, 655, 655, 655, 655, + + 655, 655, 655, 655, 655, 655, 655, 655, 655, 655, + 655, 655, 1666, 1666, 1666, 1666, 1666, 1666, 1666, 1666, + 1666, 1666, 1666, 1666, 1666, 1666, 1666, 1666, 1666, 1666, + 1707, 1707, 1707, 1707, 1707, 1707, 1707, 1707, 1707, 1707, + 1707, 1707, 1707, 1707, 1707, 1707, 1707, 1707, 1727, 1727, + 1727, 1727, 1727, 1727, 1727, 1727, 1727, 1727, 1727, 1727, + 1727, 1727, 1727, 1727, 1727, 1727, 1728, 1728, 1728, 1728, + 1728, 1728, 1728, 1728, 1728, 1728, 1728, 1728, 1728, 1728, + 1728, 1728, 1728, 1728, 1734, 1734, 1734, 1734, 1734, 1734, + 1734, 1734, 1734, 1734, 1734, 1734, 1734, 1734, 1734, 1734, + + 1734, 1734, 1752, 1752, 1752, 1752, 1752, 1752, 1752, 1752, + 1752, 1752, 1752, 1752, 1752, 1752, 1752, 1752, 1752, 1752, + 1761, 1761, 1761, 1761, 1761, 1761, 1761, 1761, 1761, 1761, + 1761, 1761, 1761, 1761, 1761, 1761, 1761, 1761, 1764, 1764, + 1764, 1764, 1764, 1764, 1764, 1764, 1764, 1764, 1764, 1764, + 1764, 1764, 1764, 1764, 1764, 1764, 1805, 1805, 1805, 1805, + 1805, 1805, 1805, 1805, 1805, 1805, 1805, 1805, 1805, 1805, + 1805, 1805, 1805, 1805, 1826, 1826, 1826, 1826, 1826, 1826, + 1826, 1826, 1826, 1826, 1826, 1826, 1826, 1826, 1826, 1826, + 1826, 1826, 15, 1854, 1854, 1854, 1854, 1854, 1854, 1854, + + 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, + 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, + 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, + 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, + 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, + 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, + 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, + 1854, 1854, 1854 + } ; + +static yyconst flex_int16_t yy_chk[9274] = + { 0, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 2, 2, 2, 2, 1800, 8, 8, 8, 8, 9, + 9, 9, 10, 10, 10, 16, 102, 72, 9, 72, + + 17, 10, 17, 19, 21, 20, 2, 2, 1799, 16, + 2, 8, 2, 8, 1875, 1875, 70, 19, 21, 24, + 22, 70, 1778, 2, 16, 102, 24, 24, 1754, 17, + 20, 108, 19, 21, 22, 2, 2, 16, 104, 2, + 8, 2, 8, 17, 20, 19, 21, 24, 1752, 22, + 27, 2, 6, 6, 6, 6, 26, 71, 17, 20, + 108, 24, 22, 28, 32, 112, 104, 27, 1728, 109, + 26, 17, 20, 33, 32, 1727, 24, 28, 6, 6, + 1721, 27, 6, 120, 6, 26, 113, 33, 32, 24, + 120, 120, 28, 71, 112, 6, 27, 109, 26, 110, + + 1702, 110, 33, 32, 98, 28, 98, 6, 6, 27, + 242, 6, 242, 6, 113, 33, 32, 59, 59, 59, + 59, 71, 98, 6, 11, 11, 11, 11, 11, 11, + 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, + 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, + 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, + 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, + 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, + 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, + 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, + + 11, 11, 11, 11, 12, 12, 12, 12, 34, 23, + 23, 23, 23, 116, 1701, 34, 12, 100, 150, 100, + 150, 314, 12, 150, 1696, 36, 25, 158, 25, 34, + 12, 12, 36, 116, 12, 100, 12, 314, 23, 25, + 106, 25, 106, 25, 34, 135, 36, 12, 118, 118, + 118, 118, 23, 117, 44, 25, 158, 34, 106, 12, + 12, 36, 116, 12, 107, 12, 107, 23, 44, 25, + 1693, 1677, 136, 135, 36, 12, 14, 14, 14, 14, + 23, 1665, 107, 44, 25, 1664, 162, 30, 30, 30, + 117, 586, 164, 107, 14, 30, 44, 25, 30, 31, + + 136, 31, 14, 14, 30, 140, 14, 586, 14, 30, + 31, 31, 31, 35, 35, 162, 30, 122, 117, 14, + 35, 164, 107, 31, 122, 122, 31, 52, 52, 803, + 30, 14, 14, 140, 35, 14, 124, 14, 167, 31, + 31, 31, 52, 124, 124, 30, 803, 14, 29, 35, + 29, 31, 37, 1659, 31, 37, 52, 52, 30, 124, + 57, 37, 35, 770, 141, 770, 29, 167, 37, 37, + 52, 159, 29, 43, 38, 137, 29, 29, 29, 38, + 57, 37, 43, 29, 37, 29, 29, 43, 124, 37, + 137, 29, 141, 38, 57, 29, 37, 37, 359, 159, + + 359, 29, 43, 38, 137, 29, 29, 29, 38, 57, + 43, 29, 359, 29, 29, 43, 160, 172, 137, 29, + 189, 38, 57, 29, 39, 46, 40, 40, 46, 39, + 40, 39, 47, 47, 899, 39, 40, 899, 39, 46, + 60, 40, 47, 39, 160, 60, 172, 47, 39, 189, + 161, 1658, 163, 39, 46, 40, 40, 46, 39, 40, + 39, 47, 47, 39, 40, 45, 39, 46, 60, 40, + 47, 39, 45, 45, 45, 47, 39, 41, 161, 45, + 163, 165, 60, 41, 1404, 41, 41, 169, 41, 41, + 61, 41, 171, 1653, 45, 41, 201, 60, 1632, 207, + + 45, 45, 45, 772, 1625, 772, 41, 45, 61, 165, + 60, 41, 48, 41, 41, 169, 41, 41, 173, 41, + 171, 48, 61, 41, 42, 201, 48, 42, 207, 1617, + 42, 42, 126, 42, 126, 1404, 138, 61, 42, 42, + 1616, 48, 139, 49, 209, 126, 173, 126, 49, 48, + 61, 138, 139, 42, 48, 49, 42, 49, 42, 42, + 50, 42, 49, 49, 51, 138, 42, 42, 50, 174, + 50, 139, 49, 209, 50, 50, 51, 49, 51, 138, + 139, 51, 210, 49, 51, 49, 889, 889, 889, 50, + 49, 49, 1614, 51, 77, 175, 50, 174, 50, 121, + + 121, 121, 50, 50, 51, 1612, 51, 121, 121, 51, + 53, 210, 51, 54, 53, 53, 134, 77, 54, 56, + 54, 56, 77, 175, 53, 134, 134, 55, 1608, 53, + 53, 56, 54, 56, 177, 55, 77, 178, 134, 53, + 55, 55, 54, 53, 53, 1605, 77, 54, 56, 54, + 56, 77, 53, 1604, 134, 134, 55, 53, 53, 56, + 54, 56, 177, 55, 77, 178, 134, 179, 55, 55, + 58, 58, 58, 58, 62, 63, 1542, 180, 62, 62, + 1541, 63, 62, 315, 63, 315, 166, 166, 62, 63, + 69, 69, 69, 62, 211, 179, 58, 58, 1410, 58, + + 58, 315, 58, 62, 63, 180, 1459, 62, 62, 63, + 1537, 62, 63, 58, 166, 166, 62, 63, 69, 1536, + 127, 62, 127, 211, 1535, 58, 58, 65, 58, 58, + 64, 58, 65, 127, 65, 127, 1533, 64, 64, 64, + 213, 58, 181, 76, 64, 184, 65, 69, 187, 1410, + 1526, 65, 75, 75, 75, 75, 65, 1459, 157, 64, + 83, 65, 79, 65, 75, 64, 64, 64, 76, 213, + 181, 76, 64, 184, 65, 157, 187, 76, 75, 65, + 1521, 360, 82, 360, 76, 76, 82, 157, 83, 79, + 79, 1458, 82, 79, 360, 188, 360, 76, 191, 79, + + 76, 125, 83, 157, 79, 76, 1456, 75, 125, 125, + 99, 82, 76, 76, 78, 82, 219, 83, 79, 79, + 82, 99, 79, 188, 85, 86, 191, 79, 85, 86, + 83, 168, 79, 1451, 85, 86, 168, 78, 99, 81, + 1652, 125, 78, 81, 78, 219, 81, 81, 78, 81, + 84, 78, 99, 85, 86, 81, 78, 85, 86, 176, + 168, 78, 85, 86, 1450, 168, 78, 99, 81, 125, + 176, 78, 81, 78, 81, 81, 78, 81, 84, 78, + 99, 1670, 229, 81, 78, 84, 84, 84, 176, 78, + 80, 1652, 84, 192, 80, 226, 193, 80, 176, 80, + + 80, 194, 80, 80, 190, 1691, 87, 84, 195, 80, + 87, 229, 190, 84, 84, 84, 87, 197, 226, 80, + 84, 192, 89, 80, 193, 80, 1448, 80, 80, 194, + 80, 80, 1670, 190, 88, 87, 195, 80, 88, 87, + 190, 182, 88, 182, 87, 197, 88, 226, 88, 203, + 89, 142, 142, 142, 88, 204, 1691, 205, 89, 142, + 89, 90, 91, 88, 89, 89, 91, 88, 142, 208, + 367, 88, 91, 90, 88, 90, 88, 203, 90, 89, + 1445, 90, 88, 204, 182, 205, 89, 93, 89, 196, + 90, 91, 89, 89, 92, 91, 1442, 208, 92, 367, + + 91, 90, 92, 90, 196, 369, 90, 220, 92, 90, + 93, 1439, 182, 92, 92, 93, 1438, 93, 196, 94, + 95, 94, 200, 92, 94, 96, 94, 92, 200, 93, + 221, 92, 196, 96, 369, 220, 92, 1437, 368, 93, + 368, 92, 92, 368, 93, 170, 93, 94, 95, 94, + 95, 200, 94, 96, 94, 1777, 200, 93, 221, 1015, + 95, 1015, 95, 97, 97, 97, 97, 96, 144, 144, + 144, 144, 231, 231, 103, 97, 144, 95, 103, 95, + 198, 103, 96, 198, 103, 144, 170, 170, 95, 97, + 95, 216, 216, 216, 216, 96, 223, 223, 223, 223, + + 231, 231, 245, 103, 245, 245, 1777, 103, 198, 103, + 1135, 198, 103, 1135, 170, 170, 1431, 1425, 97, 101, + 101, 101, 101, 101, 101, 101, 101, 101, 101, 101, + 101, 101, 101, 101, 101, 101, 101, 101, 101, 101, + 101, 101, 101, 101, 101, 101, 101, 101, 101, 101, + 101, 101, 101, 101, 101, 101, 101, 101, 101, 101, + 101, 101, 101, 101, 101, 101, 101, 101, 101, 101, + 101, 101, 101, 101, 101, 101, 101, 101, 101, 101, + 101, 101, 101, 101, 101, 101, 101, 101, 101, 101, + 101, 101, 101, 101, 101, 101, 101, 101, 101, 105, + + 391, 129, 183, 129, 183, 247, 105, 247, 247, 232, + 105, 1421, 183, 105, 129, 129, 129, 129, 130, 129, + 130, 212, 1416, 105, 227, 212, 183, 1406, 105, 391, + 148, 130, 130, 130, 130, 105, 130, 232, 105, 148, + 148, 105, 130, 131, 133, 131, 133, 227, 1405, 392, + 212, 105, 148, 129, 212, 183, 131, 131, 131, 131, + 1332, 131, 143, 143, 143, 143, 233, 1325, 148, 148, + 130, 130, 133, 199, 143, 149, 227, 149, 392, 395, + 148, 133, 351, 199, 131, 235, 149, 149, 143, 351, + 351, 133, 215, 185, 233, 131, 186, 186, 343, 149, + + 1322, 133, 199, 186, 228, 185, 215, 185, 395, 133, + 185, 199, 131, 235, 1321, 149, 149, 143, 202, 133, + 202, 215, 185, 239, 186, 186, 343, 149, 206, 218, + 1306, 186, 222, 185, 215, 185, 202, 202, 185, 222, + 202, 230, 206, 218, 228, 206, 344, 202, 230, 202, + 225, 225, 225, 225, 238, 238, 238, 206, 218, 239, + 222, 240, 241, 234, 202, 202, 319, 222, 202, 230, + 206, 218, 228, 206, 344, 234, 230, 234, 1557, 345, + 234, 1557, 238, 253, 240, 253, 325, 239, 241, 319, + 1305, 348, 234, 346, 246, 246, 246, 246, 250, 250, + + 250, 250, 253, 234, 1301, 234, 246, 345, 234, 325, + 250, 238, 253, 240, 253, 366, 1296, 241, 319, 251, + 246, 346, 348, 254, 250, 1295, 251, 251, 251, 424, + 253, 424, 254, 251, 252, 320, 1294, 252, 325, 424, + 254, 255, 257, 366, 252, 252, 252, 256, 251, 246, + 348, 252, 254, 250, 251, 251, 251, 255, 255, 257, + 254, 251, 256, 252, 256, 259, 252, 259, 254, 1292, + 255, 257, 252, 252, 252, 320, 256, 376, 262, 252, + 258, 260, 274, 1277, 259, 255, 255, 257, 378, 258, + 256, 261, 256, 260, 259, 262, 259, 258, 260, 274, + + 349, 261, 261, 320, 265, 376, 405, 262, 261, 258, + 260, 274, 259, 263, 264, 263, 378, 258, 263, 1264, + 261, 260, 266, 262, 264, 258, 260, 274, 265, 261, + 261, 264, 263, 267, 267, 405, 261, 393, 266, 266, + 349, 268, 263, 264, 263, 265, 265, 263, 394, 1256, + 267, 266, 264, 313, 269, 313, 268, 265, 268, 264, + 263, 396, 267, 267, 270, 393, 266, 266, 349, 397, + 268, 269, 269, 265, 265, 1253, 394, 273, 267, 270, + 1237, 270, 313, 269, 268, 271, 268, 272, 275, 396, + 398, 271, 406, 270, 273, 273, 272, 397, 342, 269, + + 269, 1236, 271, 275, 272, 275, 273, 270, 276, 270, + 399, 313, 342, 277, 271, 277, 272, 275, 398, 276, + 271, 406, 273, 273, 272, 276, 278, 342, 278, 279, + 271, 275, 272, 275, 1196, 425, 278, 276, 399, 277, + 342, 1151, 279, 280, 425, 425, 279, 276, 1141, 338, + 278, 338, 278, 276, 400, 280, 277, 280, 279, 1137, + 280, 309, 309, 309, 309, 1136, 1114, 338, 277, 278, + 279, 403, 280, 379, 279, 379, 379, 281, 282, 278, + 1104, 278, 400, 280, 277, 280, 281, 281, 280, 282, + 902, 283, 902, 281, 281, 282, 284, 278, 1103, 403, + + 284, 902, 283, 352, 352, 352, 281, 282, 283, 285, + 285, 352, 352, 284, 281, 281, 409, 282, 285, 404, + 283, 281, 281, 282, 1090, 284, 285, 286, 1087, 284, + 283, 287, 288, 289, 292, 300, 283, 286, 285, 285, + 287, 284, 289, 288, 286, 409, 285, 404, 287, 288, + 289, 292, 300, 300, 285, 418, 286, 290, 1779, 1072, + 287, 288, 289, 292, 300, 286, 290, 291, 287, 291, + 289, 288, 286, 1068, 290, 293, 287, 288, 289, 292, + 300, 300, 1791, 418, 291, 381, 290, 381, 381, 420, + 293, 423, 293, 293, 290, 1060, 291, 294, 291, 295, + + 1059, 410, 290, 294, 293, 295, 296, 296, 321, 1779, + 321, 295, 291, 294, 294, 354, 295, 420, 293, 423, + 293, 293, 354, 354, 296, 413, 294, 297, 295, 297, + 410, 298, 294, 1791, 295, 296, 296, 321, 299, 295, + 334, 294, 294, 416, 295, 297, 297, 299, 298, 297, + 298, 301, 296, 301, 413, 299, 297, 334, 297, 1052, + 298, 302, 302, 1047, 1023, 301, 321, 299, 301, 334, + 301, 303, 416, 297, 297, 299, 298, 297, 298, 302, + 301, 417, 301, 299, 401, 334, 303, 401, 303, 305, + 302, 302, 304, 301, 304, 305, 301, 919, 301, 426, + + 303, 340, 306, 340, 306, 1626, 305, 302, 1626, 304, + 417, 307, 401, 307, 303, 401, 303, 307, 305, 306, + 1017, 304, 1017, 304, 305, 421, 308, 426, 307, 912, + 340, 306, 308, 306, 305, 906, 412, 304, 412, 322, + 307, 322, 307, 308, 862, 616, 307, 306, 310, 310, + 310, 310, 616, 616, 421, 308, 307, 322, 412, 340, + 310, 308, 311, 311, 311, 311, 859, 323, 322, 323, + 328, 308, 357, 329, 310, 324, 324, 324, 324, 357, + 357, 328, 427, 323, 329, 323, 330, 324, 328, 330, + 428, 329, 429, 330, 323, 323, 431, 322, 332, 328, + + 432, 324, 329, 310, 332, 332, 357, 323, 855, 328, + 427, 587, 329, 587, 330, 849, 328, 330, 428, 329, + 429, 330, 837, 323, 323, 431, 332, 835, 432, 587, + 324, 820, 332, 332, 357, 323, 326, 326, 326, 326, + 326, 326, 326, 326, 326, 326, 326, 326, 326, 326, + 326, 326, 326, 326, 326, 333, 326, 326, 326, 326, + 326, 331, 331, 331, 333, 335, 336, 1628, 331, 402, + 1628, 333, 415, 415, 433, 434, 814, 335, 336, 437, + 336, 442, 335, 336, 333, 443, 402, 326, 326, 331, + 331, 331, 333, 792, 335, 336, 331, 784, 402, 333, + + 415, 415, 433, 783, 434, 335, 336, 437, 336, 442, + 335, 336, 705, 443, 402, 326, 327, 327, 327, 327, + 327, 327, 327, 327, 327, 327, 327, 327, 327, 327, + 327, 327, 327, 327, 327, 704, 327, 327, 327, 327, + 327, 337, 339, 676, 339, 341, 675, 341, 353, 353, + 353, 444, 327, 419, 337, 419, 353, 353, 337, 327, + 339, 341, 435, 341, 435, 655, 654, 327, 327, 358, + 337, 339, 341, 341, 341, 419, 358, 358, 650, 444, + 327, 370, 337, 370, 435, 341, 337, 327, 649, 436, + 361, 362, 361, 362, 375, 327, 375, 370, 430, 646, + + 339, 341, 341, 341, 361, 362, 361, 362, 361, 362, + 375, 430, 358, 341, 364, 365, 364, 365, 436, 644, + 636, 438, 439, 440, 441, 440, 370, 430, 364, 365, + 364, 365, 364, 365, 375, 380, 380, 380, 380, 430, + 358, 633, 361, 362, 1831, 440, 422, 380, 422, 364, + 438, 439, 632, 441, 370, 384, 384, 384, 384, 365, + 448, 380, 375, 384, 388, 407, 364, 365, 385, 385, + 385, 385, 384, 388, 388, 408, 385, 364, 445, 447, + 385, 407, 414, 449, 414, 385, 388, 365, 448, 422, + 380, 408, 450, 452, 385, 1831, 453, 451, 456, 457, + + 458, 454, 388, 388, 414, 451, 407, 445, 447, 454, + 459, 449, 460, 455, 388, 455, 408, 422, 414, 631, + 465, 450, 452, 385, 453, 451, 456, 457, 461, 458, + 454, 462, 463, 451, 407, 455, 464, 454, 466, 459, + 467, 460, 469, 470, 408, 411, 414, 411, 455, 465, + 471, 473, 475, 476, 477, 478, 461, 455, 479, 462, + 463, 480, 482, 481, 464, 483, 466, 411, 467, 484, + 469, 470, 411, 485, 487, 488, 455, 411, 471, 473, + 475, 476, 477, 478, 489, 455, 479, 411, 411, 480, + 503, 411, 481, 486, 490, 504, 482, 489, 484, 491, + + 618, 411, 485, 487, 488, 582, 411, 508, 483, 494, + 486, 494, 494, 489, 506, 411, 411, 503, 505, 411, + 510, 481, 486, 490, 482, 489, 504, 507, 491, 492, + 492, 492, 495, 509, 495, 495, 483, 498, 486, 498, + 498, 499, 499, 499, 499, 500, 503, 500, 500, 511, + 508, 506, 505, 499, 510, 504, 512, 491, 507, 514, + 513, 492, 517, 533, 518, 515, 509, 499, 516, 519, + 519, 523, 523, 523, 534, 524, 521, 526, 508, 506, + 505, 520, 510, 529, 514, 517, 519, 507, 585, 511, + 492, 518, 576, 523, 509, 513, 499, 512, 513, 515, + + 533, 514, 516, 521, 527, 520, 524, 1025, 534, 1025, + 528, 519, 554, 514, 517, 502, 585, 511, 526, 526, + 518, 531, 541, 513, 529, 512, 513, 515, 533, 514, + 516, 527, 521, 532, 520, 524, 534, 528, 536, 519, + 522, 522, 522, 525, 525, 525, 526, 526, 530, 530, + 530, 535, 529, 540, 537, 629, 531, 629, 532, 545, + 527, 539, 522, 538, 541, 525, 528, 522, 544, 542, + 530, 629, 522, 551, 546, 501, 543, 543, 543, 525, + 556, 536, 522, 522, 531, 535, 522, 532, 539, 547, + 538, 549, 541, 550, 540, 542, 522, 537, 543, 544, + + 546, 522, 545, 538, 548, 548, 548, 525, 552, 536, + 522, 522, 555, 535, 522, 553, 547, 539, 549, 538, + 551, 556, 540, 557, 542, 537, 548, 550, 544, 546, + 545, 538, 558, 559, 561, 555, 560, 564, 565, 566, + 562, 570, 569, 574, 552, 547, 553, 549, 551, 556, + 497, 496, 578, 572, 493, 550, 563, 563, 563, 557, + 571, 567, 568, 558, 555, 560, 562, 474, 561, 559, + 566, 472, 552, 575, 562, 553, 577, 559, 563, 574, + 564, 565, 569, 570, 573, 579, 578, 557, 567, 568, + 390, 563, 558, 572, 560, 562, 561, 559, 571, 566, + + 563, 389, 562, 589, 590, 559, 386, 574, 564, 565, + 569, 570, 383, 573, 578, 575, 577, 567, 568, 563, + 594, 572, 580, 580, 580, 580, 571, 579, 563, 581, + 581, 581, 581, 583, 583, 583, 583, 589, 588, 591, + 588, 591, 573, 575, 577, 583, 382, 590, 592, 594, + 592, 597, 607, 604, 608, 579, 588, 377, 597, 583, + 374, 647, 617, 647, 647, 589, 592, 588, 591, 617, + 617, 598, 373, 372, 603, 590, 604, 592, 594, 607, + 597, 603, 608, 593, 598, 593, 597, 901, 583, 584, + 584, 584, 584, 599, 901, 901, 588, 591, 602, 593, + + 598, 593, 605, 603, 611, 604, 592, 599, 607, 603, + 593, 593, 598, 609, 602, 584, 584, 600, 584, 584, + 613, 584, 599, 593, 610, 600, 605, 602, 600, 612, + 371, 643, 584, 611, 615, 599, 1027, 363, 1027, 593, + 593, 609, 602, 356, 584, 584, 600, 584, 584, 613, + 584, 593, 610, 600, 614, 605, 600, 612, 615, 643, + 584, 595, 595, 595, 595, 595, 595, 595, 595, 595, + 595, 595, 595, 595, 595, 595, 595, 595, 595, 595, + 355, 595, 595, 595, 595, 595, 601, 615, 601, 621, + 657, 621, 614, 350, 622, 658, 622, 595, 619, 659, + + 660, 347, 621, 601, 621, 619, 619, 622, 625, 622, + 625, 318, 595, 595, 626, 601, 626, 601, 657, 623, + 614, 623, 625, 658, 316, 595, 625, 659, 626, 660, + 623, 601, 623, 606, 623, 623, 312, 623, 663, 619, + 595, 596, 596, 596, 596, 596, 596, 596, 596, 596, + 596, 596, 596, 596, 596, 596, 596, 596, 596, 596, + 606, 596, 596, 596, 596, 596, 663, 619, 620, 703, + 596, 623, 1110, 606, 1110, 620, 620, 249, 703, 703, + 624, 630, 624, 630, 248, 661, 627, 662, 627, 606, + 667, 244, 596, 596, 624, 620, 665, 630, 624, 596, + + 627, 606, 627, 628, 627, 628, 634, 641, 634, 641, + 648, 666, 648, 648, 661, 668, 662, 628, 667, 628, + 596, 628, 634, 641, 620, 665, 669, 243, 627, 670, + 671, 628, 624, 651, 651, 651, 651, 678, 627, 678, + 666, 651, 672, 668, 682, 652, 652, 652, 652, 683, + 651, 673, 674, 652, 669, 628, 627, 652, 670, 671, + 628, 677, 652, 685, 653, 653, 653, 653, 681, 678, + 672, 652, 653, 682, 656, 656, 656, 656, 683, 673, + 674, 653, 656, 678, 686, 684, 686, 688, 689, 677, + 689, 656, 685, 691, 692, 694, 681, 695, 678, 695, + + 652, 696, 697, 699, 697, 699, 686, 700, 701, 708, + 689, 678, 679, 684, 679, 688, 706, 706, 706, 695, + 707, 691, 692, 694, 697, 699, 706, 706, 709, 706, + 696, 706, 710, 712, 679, 700, 701, 708, 706, 679, + 711, 236, 713, 714, 679, 715, 224, 711, 719, 707, + 720, 726, 728, 217, 679, 679, 709, 716, 679, 716, + 123, 710, 712, 717, 729, 717, 119, 730, 679, 711, + 713, 731, 714, 679, 715, 711, 732, 719, 720, 716, + 726, 728, 679, 679, 733, 717, 679, 721, 722, 721, + 722, 723, 729, 723, 706, 730, 734, 735, 115, 736, + + 731, 737, 114, 743, 732, 738, 740, 738, 740, 721, + 722, 744, 733, 723, 742, 738, 742, 745, 746, 748, + 749, 766, 750, 722, 734, 752, 735, 736, 740, 753, + 737, 743, 755, 756, 755, 757, 742, 758, 760, 744, + 761, 762, 763, 764, 765, 745, 746, 767, 748, 749, + 750, 722, 768, 752, 755, 769, 773, 771, 753, 776, + 74, 766, 756, 785, 757, 771, 758, 760, 761, 778, + 762, 763, 764, 765, 777, 777, 777, 786, 67, 768, + 774, 787, 775, 769, 775, 773, 771, 774, 767, 766, + 791, 774, 775, 795, 771, 779, 775, 779, 779, 776, + + 780, 775, 780, 780, 785, 778, 777, 790, 768, 774, + 781, 788, 781, 781, 786, 774, 767, 789, 782, 774, + 782, 782, 787, 796, 793, 794, 797, 776, 799, 798, + 795, 791, 785, 778, 790, 777, 788, 800, 802, 801, + 809, 806, 786, 804, 807, 812, 789, 793, 811, 810, + 787, 813, 794, 808, 815, 799, 15, 796, 795, 791, + 798, 819, 869, 790, 822, 788, 805, 805, 805, 797, + 817, 800, 807, 821, 802, 789, 793, 804, 806, 810, + 808, 794, 801, 7, 799, 796, 812, 809, 823, 798, + 869, 0, 811, 813, 815, 824, 827, 797, 805, 800, + + 817, 807, 802, 819, 821, 804, 806, 822, 810, 808, + 801, 829, 805, 825, 812, 809, 816, 816, 816, 826, + 811, 813, 815, 818, 818, 818, 824, 805, 828, 817, + 823, 819, 827, 821, 829, 822, 831, 838, 816, 832, + 805, 839, 825, 841, 836, 818, 830, 830, 830, 825, + 826, 0, 833, 833, 833, 824, 840, 828, 823, 0, + 827, 831, 846, 829, 838, 834, 834, 834, 830, 842, + 841, 825, 843, 832, 833, 836, 844, 825, 839, 826, + 845, 847, 848, 848, 848, 851, 828, 834, 852, 853, + 831, 840, 848, 838, 850, 850, 850, 854, 856, 841, + + 834, 832, 846, 845, 836, 858, 839, 860, 861, 857, + 0, 842, 847, 864, 843, 0, 850, 893, 844, 840, + 0, 0, 852, 856, 865, 851, 0, 866, 834, 853, + 846, 921, 845, 854, 857, 861, 863, 863, 863, 842, + 864, 847, 843, 875, 860, 893, 844, 881, 858, 881, + 852, 865, 856, 851, 866, 874, 0, 853, 863, 921, + 871, 854, 871, 857, 861, 867, 867, 867, 867, 864, + 875, 881, 860, 0, 0, 872, 858, 872, 871, 873, + 865, 873, 877, 866, 868, 868, 868, 868, 870, 870, + 870, 870, 880, 872, 880, 922, 874, 873, 0, 875, + + 881, 894, 890, 883, 872, 883, 870, 882, 873, 882, + 884, 876, 884, 876, 870, 870, 0, 870, 870, 896, + 870, 0, 877, 922, 874, 890, 907, 876, 907, 876, + 894, 870, 0, 872, 880, 882, 0, 873, 876, 876, + 907, 883, 923, 870, 870, 884, 870, 870, 896, 870, + 877, 876, 0, 898, 890, 885, 0, 885, 915, 870, + 915, 915, 880, 916, 882, 916, 916, 876, 876, 883, + 0, 923, 1035, 884, 1035, 1035, 891, 898, 0, 876, + 878, 878, 878, 878, 878, 878, 878, 878, 878, 878, + 878, 878, 878, 878, 878, 878, 878, 878, 878, 885, + + 878, 878, 878, 878, 878, 891, 898, 917, 917, 917, + 917, 925, 891, 924, 928, 917, 891, 927, 930, 892, + 892, 892, 931, 938, 917, 932, 886, 885, 886, 892, + 0, 878, 878, 892, 891, 1032, 0, 1032, 892, 925, + 891, 0, 924, 928, 891, 927, 930, 0, 1138, 1032, + 886, 931, 938, 932, 1032, 1138, 1138, 933, 886, 878, + 879, 879, 879, 879, 879, 879, 879, 879, 879, 879, + 879, 879, 879, 879, 879, 879, 879, 879, 879, 886, + 879, 879, 879, 879, 879, 933, 887, 886, 887, 888, + 0, 888, 900, 954, 1240, 954, 1240, 935, 0, 900, + + 900, 0, 904, 936, 904, 905, 937, 905, 908, 940, + 908, 879, 879, 904, 887, 954, 905, 888, 904, 900, + 904, 905, 908, 905, 908, 935, 908, 918, 918, 918, + 918, 936, 1195, 941, 937, 918, 908, 0, 940, 879, + 942, 1195, 1195, 887, 918, 997, 888, 997, 900, 1014, + 1036, 1014, 1036, 1036, 904, 997, 1244, 905, 1244, 1014, + 908, 939, 941, 939, 0, 908, 909, 909, 942, 909, + 909, 909, 909, 909, 909, 909, 909, 909, 909, 909, + 909, 909, 909, 909, 909, 909, 909, 909, 909, 909, + 909, 0, 943, 939, 920, 920, 920, 920, 944, 0, + + 945, 946, 920, 949, 950, 951, 920, 939, 952, 953, + 961, 920, 955, 967, 956, 968, 956, 909, 909, 909, + 920, 943, 939, 971, 959, 0, 959, 944, 945, 0, + 946, 949, 950, 0, 951, 939, 956, 952, 953, 961, + 955, 970, 967, 0, 968, 909, 959, 0, 0, 920, + 926, 926, 971, 926, 926, 926, 926, 926, 926, 926, + 926, 926, 926, 926, 926, 926, 926, 926, 926, 970, + 926, 926, 926, 926, 926, 963, 964, 963, 964, 972, + 1117, 1117, 1117, 973, 974, 0, 963, 964, 963, 964, + 963, 964, 976, 965, 965, 965, 979, 963, 964, 980, + + 966, 926, 926, 965, 965, 985, 965, 972, 965, 966, + 966, 973, 966, 974, 966, 965, 975, 977, 975, 977, + 976, 966, 981, 988, 981, 979, 986, 987, 980, 926, + 983, 989, 983, 991, 985, 992, 0, 994, 975, 977, + 995, 996, 0, 1004, 981, 999, 1001, 999, 1002, 1021, + 1003, 988, 983, 963, 964, 986, 987, 1005, 1006, 1016, + 989, 1007, 991, 1008, 992, 994, 1009, 999, 1018, 995, + 996, 965, 1004, 1010, 1001, 1010, 1002, 966, 1003, 1019, + 1021, 1022, 1020, 1024, 1020, 1005, 1026, 1006, 1016, 1007, + 1028, 1008, 1020, 1029, 1009, 1010, 1020, 1018, 1033, 1034, + + 1030, 1020, 1030, 1037, 1039, 1037, 1037, 1019, 1022, 1021, + 1030, 1040, 1024, 1042, 1030, 1026, 1041, 1043, 1028, 1030, + 1120, 1038, 1029, 1038, 1038, 1046, 1066, 1066, 1066, 1033, + 1078, 1078, 1078, 0, 0, 1108, 1042, 1022, 1127, 1130, + 0, 1034, 1045, 1041, 1157, 1039, 1157, 1040, 1066, 1120, + 1046, 0, 1078, 1043, 1105, 1105, 1105, 0, 1033, 1106, + 1106, 1106, 1106, 1108, 1105, 1042, 1157, 1127, 1130, 1034, + 1050, 1048, 1041, 1039, 1049, 1040, 1051, 1053, 1055, 1046, + 1045, 1043, 1044, 1044, 1044, 1044, 1044, 1044, 1044, 1044, + 1044, 1044, 1044, 1044, 1044, 1044, 1044, 1044, 1044, 1044, + + 1044, 1049, 1044, 1044, 1044, 1044, 1044, 1048, 1045, 1054, + 1050, 1057, 1051, 1062, 1053, 1058, 1061, 1056, 1064, 1055, + 1067, 1063, 1069, 1065, 1073, 1075, 1076, 1079, 0, 1070, + 1049, 1071, 1074, 1044, 1044, 1048, 1077, 1080, 1050, 1057, + 1051, 1064, 1053, 1054, 1056, 1058, 0, 1055, 1063, 1081, + 1061, 1062, 1065, 1069, 1070, 0, 1067, 1071, 1086, 1074, + 1080, 1044, 1076, 1083, 1073, 1077, 1088, 1075, 1057, 1079, + 1064, 1054, 1082, 1056, 1058, 1084, 1081, 1063, 1061, 1062, + 1085, 1065, 1069, 1070, 1067, 1086, 1071, 1089, 1074, 1080, + 1076, 1083, 1073, 1088, 1077, 1075, 1091, 1079, 1092, 1093, + + 1094, 1084, 1097, 1082, 1095, 1081, 1096, 1098, 1099, 1101, + 1100, 1146, 1102, 1146, 1086, 1144, 1085, 1144, 1089, 1163, + 1083, 1092, 1088, 0, 1093, 1146, 1144, 1124, 1097, 1230, + 1084, 1230, 1082, 1124, 1111, 1099, 1111, 1116, 1091, 1230, + 1113, 1094, 1096, 1112, 1085, 1112, 1095, 1089, 1163, 1098, + 1092, 1100, 1101, 1093, 1102, 0, 1124, 1097, 1107, 1107, + 1107, 1107, 1124, 1111, 1099, 1121, 1091, 1113, 1116, 1094, + 1096, 1122, 1112, 1122, 1095, 1129, 1121, 1098, 0, 1100, + 1101, 0, 1102, 1109, 1109, 1109, 1109, 1128, 1245, 1115, + 1245, 1115, 1111, 1123, 1121, 1125, 1113, 1116, 0, 0, + + 1122, 1112, 1122, 1129, 1121, 1115, 1125, 1115, 1123, 1109, + 1109, 1139, 1109, 1109, 1169, 1109, 1115, 1115, 1139, 1139, + 1140, 1128, 1123, 1160, 1125, 0, 1109, 1140, 1140, 1115, + 0, 1333, 1129, 1333, 1125, 1147, 1123, 1147, 1109, 1109, + 0, 1109, 1109, 1169, 1109, 1115, 1115, 0, 1147, 1128, + 1147, 1160, 0, 1153, 1109, 1153, 1153, 1115, 1118, 1118, + 1118, 1118, 1118, 1118, 1118, 1118, 1118, 1118, 1118, 1118, + 1118, 1118, 1118, 1118, 1118, 1118, 1118, 0, 1118, 1118, + 1118, 1118, 1118, 1142, 1143, 1142, 1143, 1118, 1154, 1161, + 1154, 1154, 1164, 1171, 1142, 1143, 1158, 1246, 1158, 1246, + + 1246, 1142, 1143, 1166, 1167, 1148, 1168, 1148, 1170, 1118, + 1118, 1149, 1150, 1149, 1150, 0, 1118, 1161, 1158, 1148, + 1164, 1148, 1171, 1148, 0, 1149, 1150, 1149, 1150, 1149, + 1150, 1166, 1167, 0, 1168, 1142, 1170, 1118, 1119, 1119, + 1119, 1119, 1119, 1119, 1119, 1119, 1119, 1119, 1119, 1119, + 1119, 1119, 1119, 1119, 1119, 1119, 1119, 1148, 1119, 1119, + 1119, 1119, 1119, 1149, 1150, 1119, 1155, 1155, 1155, 1155, + 1156, 1156, 1156, 1156, 1155, 1173, 1174, 1176, 1156, 1179, + 1180, 1181, 0, 1155, 1184, 1182, 1183, 1156, 1185, 1119, + 1119, 1192, 0, 1192, 1119, 1192, 1247, 0, 1247, 1247, + + 0, 1334, 1192, 1334, 1173, 1174, 1176, 1179, 1180, 0, + 1181, 1172, 1184, 1172, 1182, 1183, 1185, 1119, 1126, 1126, + 1126, 1126, 1126, 1126, 1126, 1126, 1126, 1126, 1126, 1126, + 1126, 1126, 1126, 1126, 1126, 1126, 1126, 1172, 1126, 1126, + 1126, 1126, 1126, 1186, 1189, 1186, 1187, 1190, 1187, 1191, + 1172, 1191, 1202, 1199, 0, 1200, 1201, 1214, 1192, 1204, + 1191, 1193, 1191, 1193, 1191, 1186, 1172, 1205, 1187, 1126, + 1126, 1191, 1193, 1189, 1193, 1190, 1193, 1194, 1172, 1194, + 1202, 1194, 1199, 1193, 1200, 1201, 1214, 1204, 1194, 1302, + 1302, 1302, 1302, 0, 1218, 1205, 1209, 1126, 1145, 1145, + + 1221, 1145, 1145, 1145, 1145, 1145, 1145, 1145, 1145, 1145, + 1145, 1145, 1145, 1145, 1145, 1145, 1145, 1145, 1145, 1145, + 1145, 1145, 1145, 1218, 1209, 1211, 1206, 1191, 1206, 1221, + 1197, 1197, 1197, 1212, 1215, 1208, 1210, 1208, 1210, 1193, + 1197, 1197, 1216, 1197, 1194, 1197, 1198, 1232, 1206, 1145, + 1145, 1145, 1197, 1211, 0, 1198, 1198, 1208, 1198, 0, + 1198, 1212, 1215, 1303, 1303, 1303, 1303, 1198, 0, 1217, + 1216, 1316, 1316, 1316, 0, 1210, 1232, 1145, 1159, 1159, + 0, 1159, 1159, 1159, 1159, 1159, 1159, 1159, 1159, 1159, + 1159, 1159, 1159, 1159, 1159, 1159, 1159, 1217, 1159, 1159, + + 1159, 1159, 1159, 1210, 1213, 1219, 1213, 1243, 1197, 1225, + 1226, 1225, 1226, 1228, 1227, 1233, 1227, 1234, 0, 1235, + 1238, 1254, 1239, 1198, 1241, 1265, 1213, 1242, 1271, 1159, + 1159, 0, 1226, 1219, 1243, 1225, 1227, 1248, 1248, 1248, + 1304, 1228, 1343, 1233, 1254, 0, 1234, 1235, 1252, 1238, + 1239, 1271, 1265, 1241, 1326, 1242, 1326, 1159, 1257, 1248, + 1249, 1249, 1249, 1243, 1225, 1326, 0, 0, 1251, 1304, + 1255, 1343, 1259, 1254, 1258, 1261, 1235, 0, 0, 1268, + 1271, 1265, 1249, 1252, 1242, 1250, 1250, 1250, 1250, 1250, + 1250, 1250, 1250, 1250, 1250, 1250, 1250, 1250, 1250, 1250, + + 1250, 1250, 1250, 1250, 1257, 1250, 1250, 1250, 1250, 1250, + 1251, 1252, 1255, 1262, 1258, 1259, 1260, 1261, 1272, 1268, + 1263, 1263, 1263, 1266, 1267, 1273, 1269, 1270, 1270, 1270, + 1274, 1276, 1257, 1278, 1275, 1279, 1250, 1250, 1251, 1287, + 1255, 1260, 1258, 1259, 1262, 1261, 1263, 1268, 1281, 1270, + 1266, 1267, 1282, 1282, 1282, 1272, 1273, 1274, 1288, 1263, + 1269, 1275, 1283, 1289, 1250, 1284, 1291, 1280, 1280, 1280, + 1260, 1276, 1286, 1262, 1278, 1263, 1293, 1279, 1307, 1266, + 1267, 1287, 1281, 1272, 1344, 1273, 1274, 1263, 1269, 1280, + 1275, 1282, 1285, 1285, 1285, 1286, 1290, 1300, 1288, 1276, + + 1289, 1291, 1278, 1283, 0, 1279, 1307, 1293, 0, 1287, + 1281, 0, 1284, 1344, 1285, 1297, 1297, 1297, 1311, 1282, + 1298, 1298, 1298, 1290, 1286, 1312, 1288, 1313, 1289, 1291, + 1314, 1283, 1299, 1299, 1299, 1307, 1293, 1318, 1317, 1300, + 1284, 1297, 1298, 1323, 0, 1327, 1311, 1327, 0, 1324, + 1323, 1323, 1290, 1312, 1299, 1313, 1324, 1324, 1314, 1327, + 1402, 1317, 1402, 0, 1408, 1318, 1408, 1300, 1345, 0, + 1297, 1308, 1308, 1308, 1308, 1308, 1308, 1308, 1308, 1308, + 1308, 1308, 1308, 1308, 1308, 1308, 1308, 1308, 1308, 1308, + 1317, 1308, 1308, 1308, 1308, 1308, 1328, 1345, 1328, 1335, + + 1335, 1335, 1335, 1351, 1347, 0, 1337, 1335, 1337, 1328, + 1414, 1328, 1414, 1339, 0, 1339, 1335, 1348, 1329, 1349, + 1329, 1353, 1308, 1308, 1330, 1331, 1330, 1331, 1337, 0, + 0, 1351, 1329, 1347, 1329, 1339, 1329, 0, 1330, 1331, + 1330, 1331, 1330, 1331, 0, 1415, 1348, 1415, 1349, 1353, + 1308, 1309, 1309, 1309, 1309, 1309, 1309, 1309, 1309, 1309, + 1309, 1309, 1309, 1309, 1309, 1309, 1309, 1309, 1309, 1309, + 1329, 1309, 1309, 1309, 1309, 1309, 1330, 1331, 1354, 1336, + 1336, 1336, 1336, 1356, 1342, 0, 1357, 1336, 1342, 1358, + 1359, 0, 1360, 1361, 1621, 1309, 1336, 1367, 1363, 1364, + + 0, 1621, 1309, 1309, 1621, 0, 1354, 1365, 1412, 1365, + 1412, 1412, 1356, 1342, 1357, 0, 0, 1342, 1358, 1359, + 1360, 0, 1361, 1309, 1352, 1367, 1352, 1363, 1364, 1365, + 1309, 1310, 1310, 1310, 1310, 1310, 1310, 1310, 1310, 1310, + 1310, 1310, 1310, 1310, 1310, 1310, 1310, 1310, 1310, 1310, + 1352, 1310, 1310, 1310, 1310, 1310, 1368, 1370, 1369, 1370, + 1369, 1370, 0, 1352, 1372, 1376, 1377, 1388, 1370, 1369, + 1382, 1369, 1381, 1369, 1381, 1371, 1371, 1371, 1383, 1352, + 1369, 0, 1310, 1310, 1368, 1371, 1371, 1378, 1371, 1378, + 1371, 1352, 1372, 1395, 1376, 1377, 1388, 1371, 1382, 1385, + + 1387, 1385, 1390, 1393, 1400, 1396, 1383, 1396, 1403, 1378, + 1310, 1381, 1394, 1398, 1394, 1398, 1401, 1407, 1409, 1411, + 1424, 1385, 1395, 1417, 1370, 1418, 1419, 1396, 1387, 1420, + 1390, 1393, 1434, 1400, 1422, 1398, 1369, 1403, 1394, 1381, + 1426, 1423, 1428, 1424, 1401, 1407, 1417, 1409, 1429, 1427, + 1417, 1419, 1418, 1371, 1436, 1435, 1420, 1432, 1430, 1411, + 1444, 1422, 1433, 1441, 1443, 1446, 1434, 1394, 1423, 1440, + 1449, 1452, 1424, 1457, 0, 1417, 1454, 1426, 0, 1417, + 1419, 1418, 1428, 1430, 1432, 1420, 1427, 1411, 1429, 1433, + 1422, 1435, 1461, 1441, 1434, 1464, 1436, 1423, 1447, 1446, + + 1440, 1457, 1444, 1453, 1443, 1426, 1449, 1454, 1466, 1801, + 1428, 1801, 1430, 1432, 1427, 1452, 1429, 1463, 1433, 1435, + 1465, 1461, 1441, 1464, 1436, 1447, 1453, 1446, 0, 1440, + 1444, 1472, 1443, 1466, 1449, 1474, 1454, 1455, 1455, 1455, + 1455, 1475, 1467, 1452, 1467, 1468, 1463, 1468, 1468, 1465, + 0, 0, 1467, 1476, 1447, 1453, 1469, 1469, 1469, 1477, + 1472, 1479, 1466, 1474, 1469, 1484, 1470, 1470, 1470, 1470, + 1475, 1480, 1481, 1469, 1470, 1482, 1471, 1471, 1471, 1471, + 1483, 1476, 1485, 1470, 1471, 1486, 1487, 1477, 1489, 1479, + 1490, 1492, 1497, 1471, 1484, 1499, 0, 1500, 0, 1480, + + 1481, 1503, 1507, 1482, 1498, 1504, 1498, 1504, 1483, 1495, + 1485, 1495, 1505, 1506, 1486, 1487, 1508, 1489, 1490, 1492, + 1495, 1497, 1495, 1499, 1495, 1500, 1498, 1504, 1509, 1503, + 1507, 1495, 1510, 1511, 1512, 1514, 1520, 1522, 1515, 1516, + 1524, 1505, 1506, 1517, 1508, 1517, 1517, 1518, 1523, 1518, + 1518, 1527, 1538, 0, 1525, 1528, 1509, 1529, 1530, 1511, + 1520, 1510, 1534, 1512, 1514, 1515, 1547, 1516, 1531, 1532, + 1540, 1551, 1543, 1522, 1550, 1523, 0, 1538, 1545, 0, + 1524, 1539, 1539, 1539, 1546, 1530, 0, 1495, 1511, 1520, + 1525, 1528, 1529, 1527, 1515, 1531, 1516, 0, 1534, 1551, + + 1550, 1522, 1547, 1539, 1523, 1545, 1538, 1540, 1524, 0, + 0, 1532, 1543, 0, 1530, 1544, 1544, 1544, 1525, 1528, + 1529, 1527, 1552, 0, 1531, 1546, 1534, 1555, 0, 1550, + 1547, 1559, 0, 1559, 1545, 1540, 1549, 1544, 1549, 1532, + 1543, 1548, 1548, 1548, 1548, 1556, 1549, 1556, 1559, 1558, + 1552, 1558, 1558, 1546, 1555, 1556, 1560, 1560, 1560, 1560, + 1561, 1561, 1561, 1569, 1560, 1564, 1565, 1572, 1561, 1568, + 1571, 1573, 1574, 1560, 1563, 1563, 1563, 1561, 1562, 1562, + 1562, 1562, 1563, 1555, 1575, 1580, 1562, 1577, 1584, 1585, + 1591, 1563, 1569, 1564, 1565, 1562, 1572, 1568, 1571, 1573, + + 1576, 1574, 1576, 1582, 1587, 1582, 1587, 1590, 1592, 1594, + 1576, 1595, 1596, 1575, 1580, 1577, 1584, 1598, 1585, 1591, + 1599, 1600, 1602, 1600, 1600, 1582, 1587, 1603, 1606, 1609, + 1607, 1622, 1624, 1610, 1613, 1590, 1615, 1592, 1594, 1620, + 1596, 1620, 0, 1599, 1611, 1611, 1611, 1618, 1595, 1620, + 1619, 1637, 0, 1598, 1611, 1639, 1602, 1607, 1610, 1613, + 1624, 1615, 0, 1629, 1629, 1629, 1629, 1609, 1622, 1603, + 1606, 1629, 1599, 0, 1618, 1633, 1595, 1619, 0, 1637, + 1629, 1598, 0, 1639, 1602, 1638, 1607, 1610, 1613, 0, + 1615, 1627, 1627, 1627, 1627, 1609, 1622, 1603, 1606, 1627, + + 1640, 1660, 1627, 1618, 1633, 1645, 1619, 1630, 1630, 1630, + 1631, 1631, 1631, 1631, 1638, 1634, 1646, 1634, 1631, 1647, + 1641, 1642, 1641, 1642, 1630, 1634, 1648, 1631, 1654, 1640, + 1641, 1642, 1655, 1656, 1645, 1660, 1657, 1657, 1657, 1661, + 1662, 1663, 1666, 1669, 0, 1646, 1657, 1682, 1647, 1666, + 1669, 1674, 1666, 1669, 1654, 1648, 0, 1655, 1674, 1681, + 1656, 1674, 1683, 1660, 1838, 1838, 1838, 1662, 1663, 0, + 1661, 0, 1667, 1667, 1667, 1667, 1682, 1668, 1668, 1668, + 1668, 1689, 0, 1654, 1667, 1668, 1655, 1681, 1668, 1656, + 0, 1683, 1672, 1672, 1672, 1672, 1662, 1663, 1667, 1661, + + 1672, 1684, 1686, 1672, 1673, 1673, 1673, 1673, 1675, 1675, + 1675, 1675, 1673, 1687, 1692, 1673, 1675, 1689, 1676, 1676, + 1676, 1676, 1679, 1690, 1679, 1675, 1676, 1667, 1694, 1684, + 1676, 1686, 1679, 1695, 1680, 1676, 1680, 1697, 1712, 1706, + 0, 1692, 1687, 1715, 1676, 1689, 0, 1680, 1713, 1680, + 1698, 1690, 1698, 1698, 1714, 1694, 1680, 1699, 1699, 1699, + 1699, 1705, 1700, 1697, 1700, 1700, 0, 1712, 1705, 1699, + 1692, 1705, 1715, 1676, 1695, 1706, 1713, 1703, 1703, 1703, + 1703, 1716, 1714, 1699, 1694, 1703, 1722, 1718, 1703, 0, + 1707, 1723, 1697, 1704, 1704, 1704, 1704, 1707, 1724, 1717, + + 1707, 1704, 1695, 1706, 1704, 1704, 1708, 1708, 1708, 1708, + 1716, 1709, 1699, 1710, 1708, 1710, 1719, 1708, 1709, 1704, + 1720, 1709, 1723, 1711, 1718, 1711, 1710, 1717, 1710, 1743, + 1746, 1741, 1722, 1741, 1711, 1710, 1711, 1725, 1711, 1725, + 1725, 1724, 1741, 1744, 1719, 1711, 1720, 1726, 1704, 1726, + 1726, 1723, 1718, 1729, 1729, 1729, 1729, 1743, 1746, 1737, + 1722, 1729, 1749, 0, 1729, 1730, 1730, 1730, 1730, 1724, + 1751, 1755, 1744, 1730, 1747, 1720, 1730, 1730, 1731, 1731, + 1731, 1731, 0, 1732, 1748, 1733, 1731, 1734, 0, 1731, + 1732, 1730, 1733, 1732, 1734, 1733, 1737, 1734, 1735, 1735, + + 1735, 1735, 1747, 1736, 1749, 1750, 1735, 1751, 1755, 1735, + 1736, 1740, 1748, 1736, 1738, 1738, 1738, 1738, 1740, 1756, + 1730, 1740, 1738, 0, 1737, 1738, 1739, 1739, 1739, 1739, + 0, 1776, 1749, 1750, 1739, 1751, 1755, 1739, 1757, 0, + 1757, 1757, 1758, 1794, 1758, 1758, 1759, 1759, 1759, 1759, + 1760, 1760, 1760, 1760, 1759, 1761, 1771, 1759, 1760, 1756, + 1776, 1760, 1761, 1763, 1773, 1761, 1762, 1762, 1762, 1762, + 1763, 1764, 1794, 1763, 1762, 1780, 0, 1762, 1764, 1796, + 1821, 1764, 1765, 1765, 1765, 1765, 1774, 1756, 1766, 1766, + 1766, 1766, 1773, 1767, 1765, 1781, 1766, 1775, 1771, 1766, + + 1767, 1811, 1792, 1767, 1768, 1768, 1768, 1768, 1765, 1821, + 1797, 1780, 1768, 1770, 1774, 1768, 1769, 1769, 1769, 1769, + 1770, 1796, 1781, 1770, 1769, 1775, 1771, 1769, 1769, 1782, + 1792, 1782, 1782, 1783, 1798, 1783, 1783, 1765, 1797, 1780, + 1812, 1811, 1769, 1788, 1784, 1784, 1784, 1784, 0, 1796, + 1788, 1781, 1784, 1788, 1835, 1784, 1785, 1785, 1785, 1785, + 0, 1819, 1813, 1814, 1785, 1814, 1814, 1785, 1812, 1811, + 1798, 1769, 1786, 1786, 1786, 1786, 1787, 1787, 1787, 1787, + 1786, 0, 1835, 1786, 1787, 0, 1790, 1787, 1787, 1789, + 1789, 1789, 1789, 1790, 1808, 1830, 1790, 1789, 1798, 1813, + + 1789, 1819, 1787, 1803, 1803, 1803, 1803, 1804, 1804, 1804, + 1804, 1803, 1805, 1807, 1803, 1804, 0, 0, 1804, 1805, + 1807, 1822, 1805, 1807, 1830, 0, 1820, 1813, 0, 1819, + 0, 1787, 1802, 1802, 1802, 1802, 1808, 1802, 1829, 1818, + 1802, 0, 1802, 1802, 1802, 0, 1818, 1802, 1802, 1818, + 0, 1828, 1802, 1820, 1802, 1802, 1802, 1806, 1806, 1806, + 1806, 1829, 0, 1822, 1808, 1806, 0, 0, 1806, 1815, + 1815, 1815, 1815, 1823, 0, 1823, 1823, 1815, 1828, 0, + 1815, 1833, 1820, 1802, 1802, 1802, 1817, 1817, 1817, 1817, + 1829, 1822, 0, 0, 1817, 1825, 0, 1817, 1824, 1824, + + 1824, 1824, 1825, 0, 1833, 1825, 1824, 1828, 1834, 1824, + 0, 1802, 1816, 1816, 1816, 1816, 1816, 1816, 1836, 1826, + 1816, 1816, 1816, 1816, 1816, 1837, 1826, 1816, 1816, 1826, + 1840, 0, 1816, 1833, 1816, 1816, 1816, 1827, 1827, 1827, + 1827, 1832, 1832, 1832, 1832, 1827, 0, 1850, 1827, 1832, + 1834, 0, 1832, 1839, 1839, 1839, 1841, 1841, 1841, 1846, + 1836, 0, 1849, 1816, 1816, 1816, 0, 1837, 0, 0, + 1840, 1842, 1842, 1842, 1843, 1843, 1843, 1843, 1834, 1844, + 1844, 1844, 1847, 1847, 1847, 1849, 1846, 0, 1836, 1850, + 0, 1816, 1851, 1851, 1851, 1837, 0, 0, 1840, 1852, + + 1852, 1852, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 1849, 1846, 0, 1850, 1855, 1855, + 1855, 1855, 1855, 1855, 1855, 1855, 1855, 1855, 1855, 1855, + 1855, 1855, 1855, 1855, 1855, 1855, 1856, 1856, 1856, 1856, + 1856, 1856, 1856, 1856, 1856, 1856, 1856, 1856, 1856, 1856, + 1856, 1856, 1856, 1856, 1857, 1857, 0, 1857, 1857, 1857, + 1857, 1857, 1857, 1857, 1857, 1857, 1857, 1857, 1857, 1857, + 1857, 1857, 1858, 1858, 1858, 1858, 1858, 1858, 1858, 1858, + 1858, 1858, 1858, 1858, 1858, 1858, 1858, 1858, 1858, 1858, + 1859, 1859, 1859, 1859, 1859, 1859, 1859, 1859, 1859, 1859, + + 1859, 1859, 1859, 1859, 1859, 1859, 1859, 1859, 1860, 0, + 0, 0, 0, 0, 0, 1860, 0, 1860, 0, 1860, + 1860, 1860, 1860, 1860, 1861, 1861, 1861, 1861, 1861, 1862, + 1862, 1862, 1862, 1862, 1862, 1862, 1862, 1862, 1862, 1862, + 1862, 1862, 1862, 1862, 1862, 1862, 1862, 1863, 1863, 1863, + 1863, 1863, 1863, 1863, 1863, 1863, 1863, 1863, 1863, 1863, + 1863, 1863, 1863, 1863, 1863, 1864, 1864, 1864, 1864, 1864, + 1864, 1864, 1864, 1864, 1864, 1864, 1864, 1864, 1864, 1864, + 1864, 1864, 1864, 1865, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 1865, 1865, 1865, 1865, 1865, 1866, + + 1866, 1866, 1866, 1866, 1866, 1866, 1866, 1866, 1866, 1866, + 1866, 1866, 1866, 1866, 1866, 1866, 1866, 1867, 1867, 0, + 1867, 1867, 1867, 1867, 1867, 1867, 1867, 1867, 1867, 1867, + 1867, 1867, 1867, 1867, 1867, 1868, 1868, 1868, 1868, 1868, + 1868, 1868, 1868, 1868, 1868, 1868, 1868, 1868, 1868, 1868, + 1868, 1868, 1868, 1869, 1869, 1869, 1869, 1869, 1869, 1869, + 1869, 1869, 1869, 1869, 1869, 1869, 1869, 1869, 1869, 1869, + 1869, 1870, 1870, 1870, 1870, 1870, 1870, 1870, 1870, 1870, + 1870, 1870, 1870, 1870, 1870, 1870, 1870, 1870, 1870, 1871, + 1871, 1871, 1871, 1871, 1871, 1871, 1871, 1871, 1871, 1871, + + 1871, 1871, 1871, 1871, 1871, 1871, 1871, 1872, 0, 0, + 0, 0, 0, 0, 1872, 0, 1872, 0, 0, 1872, + 1872, 1872, 1872, 1873, 1873, 1873, 1873, 0, 1873, 1873, + 1873, 1873, 1873, 1873, 0, 1873, 1873, 0, 0, 1873, + 1873, 1874, 1874, 1874, 1874, 1874, 1876, 1876, 1876, 1876, + 1876, 1876, 1876, 1876, 1876, 1876, 1876, 1876, 1876, 1876, + 1876, 1876, 1876, 1876, 1877, 1877, 1877, 1877, 1877, 1877, + 1877, 1877, 1877, 1877, 1877, 1877, 1877, 1877, 1877, 1877, + 1877, 1877, 1878, 1878, 1878, 1878, 1878, 1878, 1878, 1878, + 1878, 1878, 1878, 1878, 1878, 1878, 1878, 1878, 1878, 1878, + + 1879, 1879, 1879, 1879, 1879, 1879, 1879, 1879, 1879, 1879, + 1879, 1879, 1879, 1879, 1879, 1879, 1879, 1879, 1880, 1880, + 1880, 1880, 1880, 1880, 1880, 1880, 1880, 1880, 1880, 1880, + 1880, 1880, 1880, 1880, 1880, 1880, 1881, 1881, 1881, 1881, + 1881, 1881, 1881, 1881, 1881, 1881, 1881, 1881, 1881, 1881, + 1881, 1881, 1881, 1881, 1882, 1882, 1882, 1882, 1882, 1882, + 1882, 1882, 1882, 1882, 1882, 1882, 1882, 1882, 1882, 1882, + 1882, 1882, 1883, 1883, 1883, 1883, 1883, 1883, 1883, 1883, + 1883, 1883, 1883, 1883, 1883, 1883, 1883, 1883, 1883, 1883, + 1884, 1884, 1884, 1884, 1884, 1884, 1884, 1884, 1884, 1884, + + 1884, 1884, 1884, 1884, 1884, 1884, 1884, 1884, 1885, 1885, + 0, 1885, 1885, 1885, 1885, 1885, 1885, 1885, 1885, 1885, + 1885, 1885, 1885, 1885, 1885, 1885, 1886, 1886, 1886, 1886, + 1886, 1886, 1886, 1886, 1886, 1886, 1886, 1886, 1886, 1886, + 1886, 1886, 1886, 1886, 1887, 1887, 1887, 1887, 1887, 1887, + 1887, 1887, 1887, 1887, 1887, 1887, 1887, 1887, 1887, 1887, + 1887, 1887, 1888, 1888, 1888, 1888, 1888, 1888, 1888, 1888, + 1888, 1888, 1888, 1888, 1888, 1888, 1888, 1888, 1888, 1888, + 1889, 1889, 1889, 1889, 1889, 1889, 1889, 1889, 1889, 1889, + 1889, 1889, 1889, 1889, 1889, 1889, 1889, 1889, 1890, 1890, + + 1890, 1890, 1890, 1890, 1890, 1890, 1890, 1890, 1890, 1890, + 1890, 1890, 1890, 1890, 1890, 1890, 1891, 0, 0, 0, + 0, 0, 0, 1891, 0, 1891, 0, 0, 1891, 1891, + 1891, 1891, 1892, 0, 0, 0, 0, 0, 0, 0, + 1892, 0, 1892, 0, 1892, 1892, 1892, 1892, 1892, 1893, + 1893, 1893, 1893, 1894, 1894, 1894, 1894, 1894, 1894, 1894, + 1894, 1894, 1894, 1894, 1894, 1894, 1894, 1894, 1894, 1894, + 1894, 1895, 1895, 1895, 1895, 1895, 1895, 1895, 1895, 1895, + 1895, 1895, 1895, 1895, 1895, 1895, 1895, 1895, 1895, 1896, + 1896, 1896, 1896, 1896, 1896, 1896, 1896, 1896, 1896, 1896, + + 1896, 1896, 1896, 1896, 1896, 1896, 1896, 1897, 1897, 1897, + 1897, 0, 1897, 1897, 1897, 1897, 1897, 1897, 0, 1897, + 1897, 0, 0, 1897, 1897, 1898, 1898, 1898, 1898, 1898, + 1899, 1899, 1899, 1899, 1899, 1899, 1899, 1899, 1899, 1899, + 1899, 1899, 1899, 1899, 1899, 1899, 1899, 1899, 1900, 0, + 0, 0, 0, 0, 0, 0, 1900, 1900, 1901, 1901, + 1901, 1901, 1901, 1901, 1901, 1901, 1901, 1901, 1901, 1901, + 1901, 1901, 1901, 1901, 1901, 1901, 1902, 1902, 1902, 1902, + 1902, 1902, 1902, 1902, 1902, 1902, 1902, 1902, 1902, 1902, + 1902, 1902, 1902, 1902, 1903, 1903, 1903, 1903, 1903, 1903, + + 1903, 1903, 1903, 1903, 1903, 1903, 1903, 1903, 1903, 1903, + 1903, 1903, 1904, 1904, 1904, 1904, 1904, 1904, 1904, 1904, + 1904, 1904, 1904, 1904, 1904, 1904, 1904, 1904, 1904, 1904, + 1905, 1905, 1905, 1905, 1905, 1905, 1905, 1905, 1905, 1905, + 1905, 1905, 1905, 1905, 1905, 1905, 1905, 1905, 1906, 1906, + 1906, 1906, 1906, 1906, 1906, 1906, 1906, 1906, 1906, 1906, + 1906, 1906, 1906, 1906, 1906, 1906, 1907, 1907, 1907, 1907, + 1907, 1907, 1907, 1907, 1907, 1907, 1907, 1907, 1907, 1907, + 1907, 1907, 1907, 1907, 1908, 1908, 1908, 1908, 1908, 1908, + 1908, 1908, 1908, 1908, 1908, 1908, 1908, 1908, 1908, 1908, + + 1908, 1908, 1909, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 1909, 1909, 1909, 1909, 1909, 1910, 1910, + 1910, 1910, 1910, 1910, 1910, 1910, 1910, 1910, 1910, 1910, + 1910, 1910, 1910, 1910, 1910, 1910, 1911, 1911, 1911, 1911, + 1911, 1911, 1911, 1911, 1911, 1911, 1911, 1911, 1911, 1911, + 1911, 1911, 1911, 1911, 1912, 1912, 1912, 1912, 1912, 1912, + 1912, 1912, 1912, 1912, 1912, 1912, 1912, 1912, 1912, 1912, + 1912, 1912, 1913, 1913, 0, 1913, 1913, 1913, 1913, 1913, + 1913, 1913, 1913, 1913, 1913, 1913, 1913, 1913, 1913, 1913, + 1914, 1914, 1914, 1914, 1914, 1914, 1914, 1914, 1914, 1914, + + 1914, 1914, 1914, 1914, 1914, 1914, 1914, 1914, 1915, 1915, + 1915, 1915, 1915, 1915, 1915, 1915, 1915, 1915, 1915, 1915, + 1915, 1915, 1915, 1915, 1915, 1915, 1916, 1916, 1916, 1916, + 1916, 1916, 1916, 1916, 1916, 1916, 1916, 1916, 1916, 1916, + 1916, 1916, 1916, 1916, 1917, 1917, 1917, 1917, 1917, 1917, + 1917, 1917, 1917, 1917, 1917, 1917, 1917, 1917, 1917, 1917, + 1917, 1917, 1918, 0, 0, 0, 0, 0, 0, 1918, + 0, 1918, 0, 0, 1918, 1918, 1918, 1918, 1919, 0, + 0, 0, 0, 0, 0, 0, 1919, 0, 0, 0, + 1919, 1919, 1919, 1919, 1919, 1920, 0, 0, 0, 0, + + 0, 0, 0, 1920, 0, 1920, 0, 1920, 1920, 1920, + 1920, 1920, 1921, 1921, 1921, 1921, 1921, 1921, 1921, 1921, + 1921, 1921, 1921, 1921, 1921, 1921, 1921, 1921, 1921, 1921, + 1922, 1922, 1922, 1922, 1922, 1922, 1922, 1922, 1922, 1922, + 1922, 1922, 1922, 1922, 1922, 1922, 1922, 1922, 1923, 1923, + 1923, 1923, 1923, 1923, 1923, 1923, 1923, 1923, 1923, 1923, + 1923, 1923, 1923, 1923, 1923, 1923, 1924, 1924, 1924, 1924, + 1924, 1924, 1924, 1924, 1924, 1924, 1924, 1924, 1924, 1924, + 1924, 1924, 1924, 1924, 1925, 1925, 1925, 1925, 1925, 1926, + 1926, 1926, 1926, 1926, 1926, 1926, 1926, 1926, 1926, 1926, + + 1926, 1926, 1926, 1926, 1926, 1926, 1926, 1927, 1927, 1927, + 1927, 1927, 1927, 0, 1927, 1927, 1927, 1927, 1927, 1927, + 1927, 1927, 1927, 1927, 1927, 1928, 1928, 0, 1928, 1928, + 1928, 1928, 1928, 1928, 1928, 1928, 1928, 1928, 1928, 1928, + 1928, 1928, 1928, 1929, 1929, 1929, 1929, 1929, 1929, 1929, + 1929, 1929, 1929, 1929, 1929, 1929, 1929, 1929, 1929, 1929, + 1929, 1930, 1930, 1930, 1930, 1930, 1930, 1930, 1930, 1930, + 1930, 1930, 1930, 1930, 1930, 1930, 1930, 1930, 1930, 1931, + 1931, 1931, 1931, 1931, 1931, 1931, 1931, 1931, 1931, 1931, + 1931, 1931, 1931, 1931, 1931, 1931, 1931, 1932, 1932, 1932, + + 1932, 1932, 1932, 1932, 1932, 1932, 1932, 1932, 1932, 1932, + 1932, 1932, 1932, 1932, 1932, 1933, 1933, 1933, 1933, 1933, + 1933, 1933, 1933, 1933, 1933, 1933, 1933, 1933, 1933, 1933, + 1933, 1933, 1933, 1934, 1934, 1934, 1934, 1934, 1934, 1934, + 1934, 1934, 1934, 1934, 1934, 1934, 1934, 1934, 1934, 1934, + 1934, 1935, 1935, 0, 1935, 1935, 1935, 1935, 1935, 1935, + 1935, 1935, 1935, 1935, 1935, 1935, 1935, 1935, 1935, 1936, + 1936, 0, 1936, 1936, 1936, 1936, 1936, 1936, 1936, 1936, + 1936, 1936, 1936, 1936, 1936, 1936, 1936, 1937, 1937, 0, + 1937, 1937, 1937, 1937, 1937, 1937, 1937, 1937, 1937, 1937, + + 1937, 1937, 1937, 1937, 1937, 1938, 1938, 1938, 1938, 1938, + 1938, 1938, 1938, 1938, 1938, 1938, 1938, 1938, 1938, 1938, + 1938, 1938, 1938, 1939, 1939, 1939, 1939, 1939, 1939, 1939, + 1939, 1939, 1939, 1939, 1939, 1939, 1939, 1939, 1939, 1939, + 1939, 1940, 1940, 1940, 1940, 1940, 1940, 1940, 1940, 1940, + 1940, 1940, 1940, 1940, 1940, 1940, 1940, 1940, 1940, 1941, + 1941, 1941, 1941, 1941, 1941, 1941, 1941, 1941, 1941, 1941, + 1941, 1941, 1941, 1941, 1941, 1941, 1941, 1942, 0, 0, + 0, 0, 0, 1942, 0, 0, 0, 1942, 0, 1942, + 1942, 1942, 1942, 1942, 1943, 1943, 1943, 1943, 1944, 0, + + 0, 0, 0, 0, 0, 0, 1944, 0, 0, 0, + 1944, 1944, 1944, 1944, 1944, 1945, 0, 0, 0, 0, + 0, 0, 0, 1945, 0, 1945, 0, 1945, 1945, 1945, + 1945, 1945, 1946, 1946, 0, 1946, 1946, 1946, 1946, 1946, + 1946, 1946, 1946, 1946, 1946, 1946, 1946, 1946, 1946, 1946, + 1947, 1947, 1947, 1947, 1947, 1947, 1947, 1947, 1947, 1947, + 1947, 1947, 1947, 1947, 1947, 1947, 1947, 1947, 1948, 1948, + 0, 1948, 1948, 1948, 1948, 1948, 1948, 1948, 1948, 1948, + 1948, 1948, 1948, 1948, 1948, 1948, 1949, 1949, 1949, 1949, + 1949, 1949, 0, 1949, 1949, 1949, 1949, 1949, 1949, 1949, + + 1949, 1949, 1949, 1949, 1950, 1950, 0, 1950, 1950, 1950, + 1950, 1950, 1950, 1950, 1950, 1950, 1950, 1950, 1950, 1950, + 1950, 1950, 1951, 1951, 1951, 1951, 1951, 1951, 1951, 1951, + 1951, 1951, 1951, 1951, 1951, 1951, 1951, 1951, 1951, 1951, + 1952, 1952, 1952, 1952, 1952, 1952, 1952, 1952, 1952, 1952, + 1952, 1952, 1952, 1952, 1952, 1952, 1952, 1952, 1953, 1953, + 1953, 1953, 1953, 1953, 1953, 1953, 1953, 1953, 1953, 1953, + 1953, 1953, 1953, 1953, 1953, 1953, 1954, 1954, 1954, 1954, + 1954, 1954, 1954, 1954, 1954, 1954, 1954, 1954, 1954, 1954, + 1954, 1954, 1954, 1954, 1955, 1955, 1955, 1955, 1955, 1955, + + 1955, 1955, 1955, 1955, 1955, 1955, 1955, 1955, 1955, 1955, + 1955, 1955, 1956, 1956, 1956, 1956, 1956, 1956, 1956, 1956, + 1956, 1956, 1956, 1956, 1956, 1956, 1956, 1956, 1956, 1956, + 1957, 1957, 1957, 1957, 1957, 1957, 1957, 1957, 1957, 1957, + 1957, 1957, 1957, 1957, 1957, 1957, 1957, 1957, 1958, 1958, + 1958, 1958, 1958, 1958, 1958, 1958, 1958, 1958, 1958, 1958, + 1958, 1958, 1958, 1958, 1958, 1958, 1959, 1959, 1959, 1959, + 1959, 1959, 1959, 1959, 1959, 1959, 1959, 1959, 1959, 1959, + 1959, 1959, 1959, 1959, 1960, 1960, 1960, 1960, 1960, 1960, + 1960, 1960, 1960, 1960, 1960, 1960, 1960, 1960, 1960, 1960, + + 1960, 1960, 1961, 1961, 0, 1961, 1961, 1961, 1961, 1961, + 1961, 1961, 1961, 1961, 1961, 1961, 1961, 1961, 1961, 1961, + 1962, 1962, 0, 1962, 1962, 1962, 1962, 1962, 1962, 1962, + 1962, 1962, 1962, 1962, 1962, 1962, 1962, 1962, 1963, 1963, + 0, 1963, 1963, 1963, 1963, 1963, 1963, 1963, 1963, 1963, + 1963, 1963, 1963, 1963, 1963, 1963, 1964, 1964, 1964, 1964, + 1964, 1964, 1964, 1964, 1964, 1964, 1964, 1964, 1964, 1964, + 1964, 1964, 1964, 1964, 1965, 1965, 1965, 1965, 1965, 1965, + 1965, 1965, 1965, 1965, 1965, 1965, 1965, 1965, 1965, 1965, + 1965, 1965, 1966, 1966, 1966, 1966, 1966, 1966, 1966, 1966, + + 1966, 1966, 1966, 1966, 1966, 1966, 1966, 1966, 1966, 1966, + 1967, 1967, 1967, 1967, 1967, 1967, 1967, 1967, 1967, 1967, + 1967, 1967, 1967, 1967, 1967, 1967, 1967, 1967, 1968, 0, + 0, 0, 0, 0, 1968, 0, 0, 0, 0, 0, + 1968, 1968, 1968, 1968, 1968, 1969, 1969, 0, 1969, 1969, + 1969, 1969, 1969, 1969, 1969, 1969, 1969, 1969, 1969, 1969, + 1969, 1969, 1969, 1970, 0, 0, 0, 0, 0, 0, + 1970, 0, 1970, 0, 0, 1970, 1970, 1970, 1970, 1971, + 0, 0, 0, 0, 0, 0, 0, 1971, 0, 1971, + 0, 1971, 1971, 1971, 1971, 1971, 1972, 1972, 1972, 1972, + + 1973, 1973, 0, 1973, 1973, 1973, 1973, 1973, 1973, 1973, + 1973, 1973, 1973, 1973, 1973, 1973, 1973, 1973, 1974, 1974, + 1974, 1974, 1974, 1974, 0, 1974, 1974, 1974, 1974, 1974, + 1974, 1974, 1974, 1974, 1974, 1974, 1975, 1975, 0, 1975, + 1975, 1975, 1975, 1975, 1975, 1975, 1975, 1975, 1975, 1975, + 1975, 1975, 1975, 1975, 1976, 1976, 0, 1976, 1976, 1976, + 1976, 1976, 1976, 1976, 1976, 1976, 1976, 1976, 1976, 1976, + 1976, 1976, 1977, 1977, 1977, 1977, 1977, 1977, 1977, 1977, + 1977, 1977, 1977, 1977, 1977, 1977, 1977, 1977, 1977, 1977, + 1978, 1978, 1978, 1978, 1978, 1978, 1978, 1978, 1978, 1978, + + 1978, 1978, 1978, 1978, 1978, 1978, 1978, 1978, 1979, 1979, + 1979, 1979, 1979, 1979, 1979, 1979, 1979, 1979, 1979, 1979, + 1979, 1979, 1979, 1979, 1979, 1979, 1980, 1980, 1980, 1980, + 1980, 1980, 1980, 1980, 1980, 1980, 1980, 1980, 1980, 1980, + 1980, 1980, 1980, 1980, 1981, 0, 1981, 0, 0, 0, + 0, 1981, 0, 0, 1981, 1981, 1981, 1981, 1981, 1981, + 1982, 1982, 1982, 1982, 1982, 1982, 1982, 1982, 1982, 1982, + 1982, 1982, 1982, 1982, 1982, 1982, 1982, 1982, 1983, 1983, + 1983, 1983, 1983, 1983, 1983, 1983, 1983, 1983, 1983, 1983, + 1983, 1983, 1983, 1983, 1983, 1983, 1984, 1984, 1984, 1984, + + 1984, 1984, 1984, 1984, 1984, 1984, 1984, 1984, 1984, 1984, + 1984, 1984, 1984, 1984, 1985, 1985, 1985, 1985, 1985, 1985, + 1985, 1985, 1985, 1985, 1985, 1985, 1985, 1985, 1985, 1985, + 1985, 1985, 1986, 1986, 1986, 1986, 1986, 1986, 1986, 1986, + 1986, 1986, 1986, 1986, 1986, 1986, 1986, 1986, 1986, 1986, + 1987, 1987, 0, 1987, 1987, 1987, 1987, 1987, 1987, 1987, + 1987, 1987, 1987, 1987, 1987, 1987, 1987, 1987, 1988, 1988, + 1988, 1988, 1988, 1988, 1988, 1988, 1988, 1988, 1988, 1988, + 1988, 1988, 1988, 1988, 1988, 1988, 1989, 1989, 1989, 1989, + 1989, 1989, 1989, 1989, 1989, 1989, 1989, 1989, 1989, 1989, + + 1989, 1989, 1989, 1989, 1990, 0, 0, 0, 0, 0, + 1990, 0, 0, 0, 0, 0, 1990, 1990, 1990, 1990, + 1990, 1991, 0, 1991, 0, 0, 0, 0, 1991, 0, + 0, 1991, 1991, 1991, 1991, 1991, 1991, 1992, 0, 1992, + 0, 0, 0, 0, 1992, 0, 0, 1992, 1992, 1992, + 1992, 1992, 1992, 1993, 1993, 1993, 1993, 1993, 1993, 1993, + 1993, 1993, 1993, 1993, 1993, 1993, 1993, 1993, 1993, 1993, + 1993, 1994, 1994, 1994, 1994, 1994, 1995, 1995, 0, 1995, + 1995, 1995, 1995, 1995, 1995, 1995, 1995, 1995, 1995, 1995, + 1995, 1995, 1995, 1995, 1996, 1996, 1996, 1996, 1996, 1996, + + 1996, 1996, 1996, 1996, 1996, 1996, 1996, 1996, 1996, 1996, + 1996, 1996, 1997, 1997, 1997, 1997, 1997, 1997, 1997, 1997, + 1997, 1997, 1997, 1997, 1997, 1997, 1997, 1997, 1997, 1997, + 1998, 1998, 1998, 1998, 1998, 1998, 1998, 1998, 1998, 1998, + 1998, 1998, 1998, 1998, 1998, 1998, 1998, 1998, 1999, 1999, + 1999, 1999, 1999, 1999, 1999, 1999, 1999, 1999, 1999, 1999, + 1999, 1999, 1999, 1999, 1999, 1999, 2000, 2000, 2000, 2000, + 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, 2000, + 2000, 2000, 2000, 2000, 2001, 2001, 2001, 2001, 2001, 2001, + 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, 2001, + + 2001, 2001, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, + 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, 2002, + 2003, 2003, 2003, 2003, 2003, 2003, 2003, 2003, 2003, 2003, + 2003, 2003, 2003, 2003, 2003, 2003, 2003, 2003, 2004, 2004, + 2004, 2004, 2004, 2004, 2004, 2004, 2004, 2004, 2004, 2004, + 2004, 2004, 2004, 2004, 2004, 2004, 2005, 2005, 2005, 2005, + 2005, 2005, 2005, 2005, 2005, 2005, 2005, 2005, 2005, 2005, + 2005, 2005, 2005, 2005, 2006, 2006, 2006, 2006, 2006, 2006, + 2006, 2006, 2006, 2006, 2006, 2006, 2006, 2006, 2006, 2006, + 2006, 2006, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, + + 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, + 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, + 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, + 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, + 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, + 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, + 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, 1854, + 1854, 1854, 1854 + } ; + +extern int fortran__flex_debug; +int fortran__flex_debug = 0; + +static yy_state_type *yy_state_buf=0, *yy_state_ptr=0; +static char *yy_full_match; +static int yy_lp; +static int yy_looking_for_trail_begin = 0; +static int yy_full_lp; +static int *yy_full_state; +#define YY_TRAILING_MASK 0x2000 +#define YY_TRAILING_HEAD_MASK 0x4000 +#define REJECT \ +{ \ +*yy_cp = (yy_hold_char); /* undo effects of setting up fortran_text */ \ +yy_cp = (yy_full_match); /* restore poss. backed-over text */ \ +(yy_lp) = (yy_full_lp); /* restore orig. accepting pos. */ \ +(yy_state_ptr) = (yy_full_state); /* restore orig. state */ \ +yy_current_state = *(yy_state_ptr); /* restore curr. state */ \ +++(yy_lp); \ +goto find_rule; \ +} + +#define yymore() yymore_used_but_not_detected +#define YY_MORE_ADJ 0 +#define YY_RESTORE_YY_MORE_OFFSET +char *fortran_text; +#line 1 "fortran.lex" +/******************************************************************************/ +/* */ +/* CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran) */ +/* */ +/* Copyright or or Copr. Laurent Debreu (Laurent.Debreu@imag.fr) */ +/* Cyril Mazauric (Cyril_Mazauric@yahoo.fr) */ +/* This software is governed by the CeCILL-C license under French law and */ +/* abiding by the rules of distribution of free software. You can use, */ +/* modify and/ or redistribute the software under the terms of the CeCILL-C */ +/* license as circulated by CEA, CNRS and INRIA at the following URL */ +/* "http://www.cecill.info". */ +/* */ +/* As a counterpart to the access to the source code and rights to copy, */ +/* modify and redistribute granted by the license, users are provided only */ +/* with a limited warranty and the software's author, the holder of the */ +/* economic rights, and the successive licensors have only limited */ +/* liability. */ +/* */ +/* In this respect, the user's attention is drawn to the risks associated */ +/* with loading, using, modifying and/or developing or reproducing the */ +/* software by the user in light of its specific status of free software, */ +/* that may mean that it is complicated to manipulate, and that also */ +/* therefore means that it is reserved for developers and experienced */ +/* professionals having in-depth computer knowledge. Users are therefore */ +/* encouraged to load and test the software's suitability as regards their */ +/* requirements in conditions enabling the security of their systems and/or */ +/* data to be ensured and, more generally, to use and operate it in the */ +/* same conditions as regards security. */ +/* */ +/* The fact that you are presently reading this means that you have had */ +/* knowledge of the CeCILL-C license and that you accept its terms. */ +/******************************************************************************/ +/* version 1.7 */ +/******************************************************************************/ + + + + + + +#line 45 "fortran.lex" +#include +#include +#include +extern FILE * fortran_in; +#define MAX_INCLUDE_DEPTH 30 +#define YY_BUF_SIZE 64000 +YY_BUFFER_STATE include_stack[MAX_INCLUDE_DEPTH]; +int line_num_input = 0; +int newlinef90 = 0; +int tmpc; + +int lastwasendofstmt = 1; + +extern char linebuf1[1024]; +extern char linebuf2[1024]; + +int count_newlines(const char* str_in) +{ + int k, i = 0; + for( k=0 ; k=1) lastwasendofstmt=0; /*printf("VALLIJSDFLSD = %d %d %s \n",lastwasendofstmt,token_since_endofstmt,fortran_text); */ if (firstpass) { strcpy(linebuf1, linebuf2); strncpy(linebuf2, fortran_text,80);} \ + else {my_position_before=setposcur();/*printf("muposition = %d\n",my_position_before);*/ECHO;} } +#define YY_BREAK {/*printf("VALL = %d %d\n",lastwasendofstmt,token_since_endofstmt);*/if (token_since_endofstmt>=1) lastwasendofstmt=0; break;} + +void out_of_donottreat(void); + +#line 3423 "fortran.yy.c" + +#define INITIAL 0 +#define parameter 1 +#define character 2 +#define donottreat 3 +#define includestate 4 +#define fortran77style 5 +#define fortran90style 6 + +#ifndef YY_NO_UNISTD_H +/* Special case for "unistd.h", since it is non-ANSI. We include it way + * down here because we want the user's section 1 to have been scanned first. + * The user has a chance to override it with an option. + */ +#include +#endif + +#ifndef YY_EXTRA_TYPE +#define YY_EXTRA_TYPE void * +#endif + +static int yy_init_globals (void ); + +/* Accessor methods to globals. + These are made visible to non-reentrant scanners for convenience. */ + +int fortran_lex_destroy (void ); + +int fortran_get_debug (void ); + +void fortran_set_debug (int debug_flag ); + +YY_EXTRA_TYPE fortran_get_extra (void ); + +void fortran_set_extra (YY_EXTRA_TYPE user_defined ); + +FILE *fortran_get_in (void ); + +void fortran_set_in (FILE * in_str ); + +FILE *fortran_get_out (void ); + +void fortran_set_out (FILE * out_str ); + +yy_size_t fortran_get_leng (void ); + +char *fortran_get_text (void ); + +int fortran_get_lineno (void ); + +void fortran_set_lineno (int line_number ); + +/* Macros after this point can all be overridden by user definitions in + * section 1. + */ + +#ifndef YY_SKIP_YYWRAP +#ifdef __cplusplus +extern "C" int fortran_wrap (void ); +#else +extern int fortran_wrap (void ); +#endif +#endif + + static void yyunput (int c,char *buf_ptr ); + +#ifndef yytext_ptr +static void yy_flex_strncpy (char *,yyconst char *,int ); +#endif + +#ifdef YY_NEED_STRLEN +static int yy_flex_strlen (yyconst char * ); +#endif + +#ifndef YY_NO_INPUT + +#ifdef __cplusplus +static int yyinput (void ); +#else +static int input (void ); +#endif + +#endif + +/* Amount of stuff to slurp up with each read. */ +#ifndef YY_READ_BUF_SIZE +#define YY_READ_BUF_SIZE 8192 +#endif + +/* Copy whatever the last rule matched to the standard output. */ +#ifndef ECHO +/* This used to be an fputs(), but since the string might contain NUL's, + * we now use fwrite(). + */ +#define ECHO fwrite( fortran_text, fortran_leng, 1, fortran_out ) +#endif + +/* Gets input and stuffs it into "buf". number of characters read, or YY_NULL, + * is returned in "result". + */ +#ifndef YY_INPUT +#define YY_INPUT(buf,result,max_size) \ + if ( YY_CURRENT_BUFFER_LVALUE->yy_is_interactive ) \ + { \ + int c = '*'; \ + yy_size_t n; \ + for ( n = 0; n < max_size && \ + (c = getc( fortran_in )) != EOF && c != '\n'; ++n ) \ + buf[n] = (char) c; \ + if ( c == '\n' ) \ + buf[n++] = (char) c; \ + if ( c == EOF && ferror( fortran_in ) ) \ + YY_FATAL_ERROR( "input in flex scanner failed" ); \ + result = n; \ + } \ + else \ + { \ + errno=0; \ + while ( (result = fread(buf, 1, max_size, fortran_in))==0 && ferror(fortran_in)) \ + { \ + if( errno != EINTR) \ + { \ + YY_FATAL_ERROR( "input in flex scanner failed" ); \ + break; \ + } \ + errno=0; \ + clearerr(fortran_in); \ + } \ + }\ +\ + +#endif + +/* No semi-colon after return; correct usage is to write "yyterminate();" - + * we don't want an extra ';' after the "return" because that will cause + * some compilers to complain about unreachable statements. + */ +#ifndef yyterminate +#define yyterminate() return YY_NULL +#endif + +/* Number of entries by which start-condition stack grows. */ +#ifndef YY_START_STACK_INCR +#define YY_START_STACK_INCR 25 +#endif + +/* Report a fatal error. */ +#ifndef YY_FATAL_ERROR +#define YY_FATAL_ERROR(msg) yy_fatal_error( msg ) +#endif + +/* end tables serialization structures and prototypes */ + +/* Default declaration of generated scanner - a define so the user can + * easily add parameters. + */ +#ifndef YY_DECL +#define YY_DECL_IS_OURS 1 + +extern int fortran_lex (void); + +#define YY_DECL int fortran_lex (void) +#endif /* !YY_DECL */ + +/* Code executed at the beginning of each rule, after fortran_text and fortran_leng + * have been set up. + */ +#ifndef YY_USER_ACTION +#define YY_USER_ACTION +#endif + +/* Code executed at the end of each rule. */ +#ifndef YY_BREAK +#define YY_BREAK break; +#endif + +#define YY_RULE_SETUP \ + if ( fortran_leng > 0 ) \ + YY_CURRENT_BUFFER_LVALUE->yy_at_bol = \ + (fortran_text[fortran_leng - 1] == '\n'); \ + YY_USER_ACTION + +/** The main scanner function which does all the work. + */ +YY_DECL +{ + register yy_state_type yy_current_state; + register char *yy_cp, *yy_bp; + register int yy_act; + +#line 100 "fortran.lex" + + if (infixed) BEGIN(fortran77style) ; + if (infree) BEGIN(fortran90style) ; + +#line 3619 "fortran.yy.c" + + if ( !(yy_init) ) + { + (yy_init) = 1; + +#ifdef YY_USER_INIT + YY_USER_INIT; +#endif + + /* Create the reject buffer large enough to save one state per allowed character. */ + if ( ! (yy_state_buf) ) + (yy_state_buf) = (yy_state_type *)fortran_alloc(YY_STATE_BUF_SIZE ); + if ( ! (yy_state_buf) ) + YY_FATAL_ERROR( "out of dynamic memory in fortran_lex()" ); + + if ( ! (yy_start) ) + (yy_start) = 1; /* first start state */ + + if ( ! fortran_in ) + fortran_in = stdin; + + if ( ! fortran_out ) + fortran_out = stdout; + + if ( ! YY_CURRENT_BUFFER ) { + fortran_ensure_buffer_stack (); + YY_CURRENT_BUFFER_LVALUE = + fortran__create_buffer(fortran_in,YY_BUF_SIZE ); + } + + fortran__load_buffer_state( ); + } + + while ( 1 ) /* loops until end-of-file is reached */ + { + yy_cp = (yy_c_buf_p); + + /* Support of fortran_text. */ + *yy_cp = (yy_hold_char); + + /* yy_bp points to the position in yy_ch_buf of the start of + * the current run. + */ + yy_bp = yy_cp; + + yy_current_state = (yy_start); + yy_current_state += YY_AT_BOL(); + + (yy_state_ptr) = (yy_state_buf); + *(yy_state_ptr)++ = yy_current_state; + +yy_match: + do + { + register YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)]; + while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) + { + yy_current_state = (int) yy_def[yy_current_state]; + if ( yy_current_state >= 1855 ) + yy_c = yy_meta[(unsigned int) yy_c]; + } + yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c]; + *(yy_state_ptr)++ = yy_current_state; + ++yy_cp; + } + while ( yy_base[yy_current_state] != 9193 ); + +yy_find_action: + yy_current_state = *--(yy_state_ptr); + (yy_lp) = yy_accept[yy_current_state]; +goto find_rule; /* Shut up GCC warning -Wall */ +find_rule: /* we branch to this label when backing up */ + for ( ; ; ) /* until we find what rule we matched */ + { + if ( (yy_lp) && (yy_lp) < yy_accept[yy_current_state + 1] ) + { + yy_act = yy_acclist[(yy_lp)]; + if ( yy_act & YY_TRAILING_HEAD_MASK || + (yy_looking_for_trail_begin) ) + { + if ( yy_act == (yy_looking_for_trail_begin) ) + { + (yy_looking_for_trail_begin) = 0; + yy_act &= ~YY_TRAILING_HEAD_MASK; + break; + } + } + else if ( yy_act & YY_TRAILING_MASK ) + { + (yy_looking_for_trail_begin) = yy_act & ~YY_TRAILING_MASK; + (yy_looking_for_trail_begin) |= YY_TRAILING_HEAD_MASK; + } + else + { + (yy_full_match) = yy_cp; + (yy_full_state) = (yy_state_ptr); + (yy_full_lp) = (yy_lp); + break; + } + ++(yy_lp); + goto find_rule; + } + --yy_cp; + yy_current_state = *--(yy_state_ptr); + (yy_lp) = yy_accept[yy_current_state]; + } + + YY_DO_BEFORE_ACTION; + +do_action: /* This label is used only to access EOF actions. */ + + switch ( yy_act ) + { /* beginning of action switch */ +case 1: +YY_RULE_SETUP +#line 104 "fortran.lex" +{ return TOK_SUBROUTINE; } + YY_BREAK +case 2: +YY_RULE_SETUP +#line 105 "fortran.lex" +{ return TOK_PROGRAM; } + YY_BREAK +case 3: +YY_RULE_SETUP +#line 106 "fortran.lex" +{ inallocate = 1; return TOK_ALLOCATE; } + YY_BREAK +case 4: +YY_RULE_SETUP +#line 107 "fortran.lex" +{ return TOK_CONTINUE; } + YY_BREAK +case 5: +YY_RULE_SETUP +#line 108 "fortran.lex" +{ return TOK_NULLIFY; } + YY_BREAK +case 6: +YY_RULE_SETUP +#line 109 "fortran.lex" +{ inallocate = 1; return TOK_DEALLOCATE; } + YY_BREAK +case 7: +YY_RULE_SETUP +#line 110 "fortran.lex" +{ return TOK_RESULT; } + YY_BREAK +case 8: +YY_RULE_SETUP +#line 111 "fortran.lex" +{ return TOK_FUNCTION; } + YY_BREAK +case 9: +YY_RULE_SETUP +#line 112 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_ENDUNIT;} + YY_BREAK +case 10: +YY_RULE_SETUP +#line 113 "fortran.lex" +{ pos_curinclude = setposcur()-9; BEGIN(includestate); } + YY_BREAK +case 11: +YY_RULE_SETUP +#line 114 "fortran.lex" +{ return TOK_USE;} + YY_BREAK +case 12: +YY_RULE_SETUP +#line 115 "fortran.lex" +{ return TOK_REWIND; } + YY_BREAK +case 13: +YY_RULE_SETUP +#line 116 "fortran.lex" +{ return TOK_IMPLICIT; } + YY_BREAK +case 14: +YY_RULE_SETUP +#line 117 "fortran.lex" +{ return TOK_NONE; } + YY_BREAK +case 15: +YY_RULE_SETUP +#line 118 "fortran.lex" +{ return TOK_CALL; } + YY_BREAK +case 16: +YY_RULE_SETUP +#line 119 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_TRUE; } + YY_BREAK +case 17: +YY_RULE_SETUP +#line 120 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_FALSE; } + YY_BREAK +case 18: +YY_RULE_SETUP +#line 121 "fortran.lex" +{ return TOK_POINT_TO; } + YY_BREAK +case 19: +YY_RULE_SETUP +#line 122 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_ASSIGNTYPE;} + YY_BREAK +case 20: +YY_RULE_SETUP +#line 123 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_DASTER; } + YY_BREAK +case 21: +YY_RULE_SETUP +#line 124 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_EQV; } + YY_BREAK +case 22: +YY_RULE_SETUP +#line 125 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_EQ; } + YY_BREAK +case 23: +YY_RULE_SETUP +#line 126 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_GT; } + YY_BREAK +case 24: +YY_RULE_SETUP +#line 127 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_GE; } + YY_BREAK +case 25: +YY_RULE_SETUP +#line 128 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_LT; } + YY_BREAK +case 26: +YY_RULE_SETUP +#line 129 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_LE; } + YY_BREAK +case 27: +YY_RULE_SETUP +#line 130 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_NEQV;} + YY_BREAK +case 28: +YY_RULE_SETUP +#line 131 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_NE; } + YY_BREAK +case 29: +YY_RULE_SETUP +#line 132 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_NOT; } + YY_BREAK +case 30: +YY_RULE_SETUP +#line 133 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_OR; } + YY_BREAK +case 31: +YY_RULE_SETUP +#line 134 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_XOR; } + YY_BREAK +case 32: +YY_RULE_SETUP +#line 135 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_AND; } + YY_BREAK +case 33: +YY_RULE_SETUP +#line 136 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_EQUALEQUAL; } + YY_BREAK +case 34: +YY_RULE_SETUP +#line 137 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_SLASHEQUAL; } + YY_BREAK +case 35: +YY_RULE_SETUP +#line 138 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_INFEQUAL; } + YY_BREAK +case 36: +YY_RULE_SETUP +#line 139 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_SUPEQUAL; } + YY_BREAK +case 37: +YY_RULE_SETUP +#line 140 "fortran.lex" +{ return TOK_MODULE; } + YY_BREAK +case 38: +YY_RULE_SETUP +#line 141 "fortran.lex" +{ return TOK_WHILE; } + YY_BREAK +case 39: +YY_RULE_SETUP +#line 142 "fortran.lex" +{ return TOK_CONCURRENT; } + YY_BREAK +case 40: +YY_RULE_SETUP +#line 143 "fortran.lex" +{ return TOK_ENDDO; } + YY_BREAK +case 41: +YY_RULE_SETUP +#line 144 "fortran.lex" +{ strcpy(yylval.na,&fortran_text[2]); + if (testandextractfromlist(&List_Do_labels,&fortran_text[2]) == 1) + { + return TOK_PLAINDO_LABEL_DJVIEW; + } + else + { + List_Do_labels=Insertname(List_Do_labels,yylval.na,1); + return TOK_PLAINDO_LABEL; + } + } + YY_BREAK +case 42: +YY_RULE_SETUP +#line 155 "fortran.lex" +{ increment_nbtokens = 0; return TOK_PLAINDO;} + YY_BREAK +case 43: +YY_RULE_SETUP +#line 156 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_REAL; } + YY_BREAK +case 44: +YY_RULE_SETUP +#line 157 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_INTEGER; } + YY_BREAK +case 45: +YY_RULE_SETUP +#line 158 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_LOGICAL; } + YY_BREAK +case 46: +YY_RULE_SETUP +#line 159 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_CHARACTER; } + YY_BREAK +case 47: +YY_RULE_SETUP +#line 160 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_HEXA;} + YY_BREAK +case 48: +YY_RULE_SETUP +#line 161 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_DOUBLEPRECISION; } + YY_BREAK +case 49: +YY_RULE_SETUP +#line 162 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_DOUBLECOMPLEX; } + YY_BREAK +case 50: +YY_RULE_SETUP +#line 163 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_COMPLEX; } + YY_BREAK +case 51: +YY_RULE_SETUP +#line 164 "fortran.lex" +{ return TOK_ALLOCATABLE; } + YY_BREAK +case 52: +YY_RULE_SETUP +#line 165 "fortran.lex" +{ return TOK_CLOSE; } + YY_BREAK +case 53: +YY_RULE_SETUP +#line 166 "fortran.lex" +{ return TOK_INQUIRE; } + YY_BREAK +case 54: +YY_RULE_SETUP +#line 167 "fortran.lex" +{ return TOK_DIMENSION; } + YY_BREAK +case 55: +YY_RULE_SETUP +#line 168 "fortran.lex" +{ return TOK_PAUSE; } + YY_BREAK +case 56: +YY_RULE_SETUP +#line 169 "fortran.lex" +{ return TOK_EQUIVALENCE; } + YY_BREAK +case 57: +YY_RULE_SETUP +#line 170 "fortran.lex" +{ return TOK_STOP; } + YY_BREAK +case 58: +YY_RULE_SETUP +#line 171 "fortran.lex" +{ return TOK_WHERE; } + YY_BREAK +case 59: +YY_RULE_SETUP +#line 172 "fortran.lex" +{ return TOK_ENDWHERE; } + YY_BREAK +case 60: +YY_RULE_SETUP +#line 173 "fortran.lex" +{ return TOK_ELSEWHEREPAR; } + YY_BREAK +case 61: +YY_RULE_SETUP +#line 174 "fortran.lex" +{ return TOK_ELSEWHERE; } + YY_BREAK +case 62: +YY_RULE_SETUP +#line 175 "fortran.lex" +{ return TOK_CONTAINS; } + YY_BREAK +case 63: +YY_RULE_SETUP +#line 176 "fortran.lex" +{ return TOK_ONLY; } + YY_BREAK +case 64: +YY_RULE_SETUP +#line 177 "fortran.lex" +{ return TOK_PARAMETER; } + YY_BREAK +case 65: +YY_RULE_SETUP +#line 178 "fortran.lex" +{ return TOK_RECURSIVE; } + YY_BREAK +case 66: +YY_RULE_SETUP +#line 179 "fortran.lex" +{ return TOK_COMMON; } + YY_BREAK +case 67: +YY_RULE_SETUP +#line 180 "fortran.lex" +{ return TOK_GLOBAL; } + YY_BREAK +case 68: +YY_RULE_SETUP +#line 181 "fortran.lex" +{ return TOK_EXTERNAL; } + YY_BREAK +case 69: +YY_RULE_SETUP +#line 182 "fortran.lex" +{ return TOK_INTENT; } + YY_BREAK +case 70: +YY_RULE_SETUP +#line 183 "fortran.lex" +{ return TOK_POINTER; } + YY_BREAK +case 71: +YY_RULE_SETUP +#line 184 "fortran.lex" +{ return TOK_OPTIONAL; } + YY_BREAK +case 72: +YY_RULE_SETUP +#line 185 "fortran.lex" +{ return TOK_SAVE; } + YY_BREAK +case 73: +YY_RULE_SETUP +#line 186 "fortran.lex" +{ pos_cur_decl = setposcur()-5; return TOK_TYPEPAR; } + YY_BREAK +case 74: +YY_RULE_SETUP +#line 187 "fortran.lex" +{ return TOK_TYPE; } + YY_BREAK +case 75: +YY_RULE_SETUP +#line 188 "fortran.lex" +{ return TOK_ENDTYPE; } + YY_BREAK +case 76: +YY_RULE_SETUP +#line 189 "fortran.lex" +{ if (inallocate == 1) return TOK_STAT; else { strcpy(yylval.na,fortran_text); return TOK_NAME; } } + YY_BREAK +case 77: +YY_RULE_SETUP +#line 190 "fortran.lex" +{ return TOK_OPEN; } + YY_BREAK +case 78: +YY_RULE_SETUP +#line 191 "fortran.lex" +{ return TOK_RETURN; } + YY_BREAK +case 79: +YY_RULE_SETUP +#line 192 "fortran.lex" +{ return TOK_EXIT; } + YY_BREAK +case 80: +YY_RULE_SETUP +#line 193 "fortran.lex" +{ return TOK_PRINT; } + YY_BREAK +case 81: +YY_RULE_SETUP +#line 194 "fortran.lex" +{ return TOK_PROCEDURE; } + YY_BREAK +case 82: +YY_RULE_SETUP +#line 195 "fortran.lex" +{ in_io_control_spec = 1; return TOK_READ_PAR; } + YY_BREAK +case 83: +YY_RULE_SETUP +#line 196 "fortran.lex" +{ return TOK_READ; } + YY_BREAK +case 84: +YY_RULE_SETUP +#line 197 "fortran.lex" +{ return TOK_NAMELIST; } + YY_BREAK +case 85: +YY_RULE_SETUP +#line 198 "fortran.lex" +{ in_io_control_spec = 1; return TOK_WRITE_PAR; } + YY_BREAK +case 86: +YY_RULE_SETUP +#line 199 "fortran.lex" +{ return TOK_WRITE; } + YY_BREAK +case 87: +YY_RULE_SETUP +#line 200 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_FLUSH; } + YY_BREAK +case 88: +YY_RULE_SETUP +#line 201 "fortran.lex" +{ return TOK_TARGET; } + YY_BREAK +case 89: +YY_RULE_SETUP +#line 202 "fortran.lex" +{ return TOK_PUBLIC; } + YY_BREAK +case 90: +YY_RULE_SETUP +#line 203 "fortran.lex" +{ return TOK_PRIVATE; } + YY_BREAK +case 91: +YY_RULE_SETUP +#line 204 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_IN; } + YY_BREAK +case 92: +YY_RULE_SETUP +#line 205 "fortran.lex" +{ pos_curdata = setposcur()-strlen(fortran_text); /*Init_List_Data_Var();*/ return TOK_DATA; } + YY_BREAK +case 93: +YY_RULE_SETUP +#line 206 "fortran.lex" +{ return TOK_PLAINGOTO; } + YY_BREAK +case 94: +YY_RULE_SETUP +#line 207 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_OUT; } + YY_BREAK +case 95: +YY_RULE_SETUP +#line 208 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_INOUT; } + YY_BREAK +case 96: +YY_RULE_SETUP +#line 209 "fortran.lex" +{ return TOK_INTRINSIC; } + YY_BREAK +case 97: +YY_RULE_SETUP +#line 210 "fortran.lex" +{ return TOK_THEN; } + YY_BREAK +case 98: +YY_RULE_SETUP +#line 211 "fortran.lex" +{ return TOK_ELSEIF; } + YY_BREAK +case 99: +YY_RULE_SETUP +#line 212 "fortran.lex" +{ return TOK_ELSE; } + YY_BREAK +case 100: +YY_RULE_SETUP +#line 213 "fortran.lex" +{ return TOK_ENDIF; } + YY_BREAK +case 101: +YY_RULE_SETUP +#line 214 "fortran.lex" +{strcpy(yylval.na,fortran_text); + return TOK_LOGICALIF_PAR; + } + YY_BREAK +case 102: +/* rule 102 can match eol */ +*yy_cp = (yy_hold_char); /* undo effects of setting up fortran_text */ +(yy_c_buf_p) = yy_cp = yy_bp + 2; +YY_DO_BEFORE_ACTION; /* set up fortran_text again */ +YY_RULE_SETUP +#line 217 "fortran.lex" +{strcpy(yylval.na,fortran_text); + return TOK_NAME; + } + YY_BREAK +case 103: +YY_RULE_SETUP +#line 220 "fortran.lex" +{strcpy(yylval.na,fortran_text); + return TOK_LOGICALIF_PAR; + } + YY_BREAK +case 104: +YY_RULE_SETUP +#line 223 "fortran.lex" +{ return TOK_SELECTCASE; } + YY_BREAK +case 105: +YY_RULE_SETUP +#line 224 "fortran.lex" +{ if (in_select_case_stmt > 0) return TOK_CASE ; else return TOK_NAME;} + YY_BREAK +case 106: +YY_RULE_SETUP +#line 225 "fortran.lex" +{ return TOK_DEFAULT; } + YY_BREAK +case 107: +YY_RULE_SETUP +#line 226 "fortran.lex" +{ return TOK_ENDSELECT; } + YY_BREAK +case 108: +YY_RULE_SETUP +#line 227 "fortran.lex" +{ return TOK_FILE; } + YY_BREAK +case 109: +YY_RULE_SETUP +#line 228 "fortran.lex" +{ return TOK_ACCESS; } + YY_BREAK +case 110: +YY_RULE_SETUP +#line 229 "fortran.lex" +{ return TOK_ACTION; } + YY_BREAK +case 111: +YY_RULE_SETUP +#line 230 "fortran.lex" +{ return TOK_IOLENGTH; } + YY_BREAK +case 112: +YY_RULE_SETUP +#line 231 "fortran.lex" +{ return TOK_UNIT; } + YY_BREAK +case 113: +YY_RULE_SETUP +#line 232 "fortran.lex" +{ return TOK_OPENED; } + YY_BREAK +case 114: +YY_RULE_SETUP +#line 233 "fortran.lex" +{ return TOK_FMT; } + YY_BREAK +case 115: +YY_RULE_SETUP +#line 234 "fortran.lex" +{ return TOK_NML; } + YY_BREAK +case 116: +YY_RULE_SETUP +#line 235 "fortran.lex" +{ return TOK_END; } + YY_BREAK +case 117: +YY_RULE_SETUP +#line 236 "fortran.lex" +{ return TOK_EOR; } + YY_BREAK +case 118: +*yy_cp = (yy_hold_char); /* undo effects of setting up fortran_text */ +(yy_c_buf_p) = yy_cp = yy_bp + 3; +YY_DO_BEFORE_ACTION; /* set up fortran_text again */ +YY_RULE_SETUP +#line 237 "fortran.lex" +{ + if (in_char_selector ==1) + return TOK_LEN; + else + { + strcpy(yylval.na,fortran_text); return TOK_NAME; + } + } + YY_BREAK +case 119: +*yy_cp = (yy_hold_char); /* undo effects of setting up fortran_text */ +(yy_c_buf_p) = yy_cp = yy_bp + 4; +YY_DO_BEFORE_ACTION; /* set up fortran_text again */ +YY_RULE_SETUP +#line 245 "fortran.lex" +{ + if ((in_char_selector==1) || (in_kind_selector == 1)) + return TOK_KIND; + else + { + strcpy(yylval.na,fortran_text); return TOK_NAME; + } + } + YY_BREAK +case 120: +YY_RULE_SETUP +#line 253 "fortran.lex" +{ return TOK_ERRMSG; } + YY_BREAK +case 121: +YY_RULE_SETUP +#line 254 "fortran.lex" +{ return TOK_MOLD; } + YY_BREAK +case 122: +YY_RULE_SETUP +#line 255 "fortran.lex" +{ return TOK_SOURCE; } + YY_BREAK +case 123: +YY_RULE_SETUP +#line 256 "fortran.lex" +{ return TOK_POSITION; } + YY_BREAK +case 124: +YY_RULE_SETUP +#line 257 "fortran.lex" +{ return TOK_IOMSG; } + YY_BREAK +case 125: +YY_RULE_SETUP +#line 258 "fortran.lex" +{ return TOK_IOSTAT; } + YY_BREAK +case 126: +YY_RULE_SETUP +#line 259 "fortran.lex" +{ return TOK_ERR; } + YY_BREAK +case 127: +YY_RULE_SETUP +#line 260 "fortran.lex" +{ return TOK_FORM; } + YY_BREAK +case 128: +*yy_cp = (yy_hold_char); /* undo effects of setting up fortran_text */ +(yy_c_buf_p) = yy_cp = yy_bp + 4; +YY_DO_BEFORE_ACTION; /* set up fortran_text again */ +YY_RULE_SETUP +#line 261 "fortran.lex" +{ + if (in_inquire==1) + return TOK_NAME_EQ; + else + { + strcpy(yylval.na,fortran_text); return TOK_NAME; + } + } + YY_BREAK +case 129: +YY_RULE_SETUP +#line 269 "fortran.lex" +{ return TOK_RECL; } + YY_BREAK +case 130: +*yy_cp = (yy_hold_char); /* undo effects of setting up fortran_text */ +(yy_c_buf_p) = yy_cp = yy_bp + 3; +YY_DO_BEFORE_ACTION; /* set up fortran_text again */ +YY_RULE_SETUP +#line 270 "fortran.lex" +{ if (in_io_control_spec == 1) + return TOK_REC; + else + { + strcpy(yylval.na,fortran_text); return TOK_NAME; + } + } + YY_BREAK +case 131: +*yy_cp = (yy_hold_char); /* undo effects of setting up fortran_text */ +(yy_c_buf_p) = yy_cp = yy_bp + 6; +YY_DO_BEFORE_ACTION; /* set up fortran_text again */ +YY_RULE_SETUP +#line 277 "fortran.lex" +{ if (close_or_connect == 1) + return TOK_STATUS; + else + { + strcpy(yylval.na,fortran_text); return TOK_NAME; + } + } + YY_BREAK +case 132: +YY_RULE_SETUP +#line 284 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_NAME;} + YY_BREAK +case 133: +YY_RULE_SETUP +#line 285 "fortran.lex" +{ return TOK_EXIST; } + YY_BREAK +case 134: +YY_RULE_SETUP +#line 286 "fortran.lex" +{ return TOK_CYCLE; } + YY_BREAK +case 135: +YY_RULE_SETUP +#line 287 "fortran.lex" +{ return TOK_BACKSPACE; } + YY_BREAK +case 136: +YY_RULE_SETUP +#line 288 "fortran.lex" +{ return TOK_FOURDOTS; } + YY_BREAK +case 137: +/* rule 137 can match eol */ +YY_RULE_SETUP +#line 289 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_DSLASH; } + YY_BREAK +case 138: +YY_RULE_SETUP +#line 290 "fortran.lex" +{ return TOK_LEFTAB; } + YY_BREAK +case 139: +YY_RULE_SETUP +#line 291 "fortran.lex" +{ return TOK_RIGHTAB; } + YY_BREAK +case 140: +YY_RULE_SETUP +#line 292 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_SLASH; } + YY_BREAK +case 141: +/* rule 141 can match eol */ +YY_RULE_SETUP +#line 293 "fortran.lex" +{ + INCREMENT_LINE_NUM() ; strcpy(yylval.na,fortran_text); return TOK_CHAR_CUT; } + YY_BREAK +case 142: +/* rule 142 can match eol */ +YY_RULE_SETUP +#line 295 "fortran.lex" +{Add_Include_1(fortran_text);} + YY_BREAK +case 143: +YY_RULE_SETUP +#line 296 "fortran.lex" +{} + YY_BREAK +case 144: +/* rule 144 can match eol */ +YY_RULE_SETUP +#line 297 "fortran.lex" +{ + if (inmoduledeclare == 0 ) + { + pos_end=setposcur(); + RemoveWordSET_0(fortran_out,pos_curinclude,pos_end-pos_curinclude); + } + out_of_donottreat(); + } + YY_BREAK +case 145: +/* rule 145 can match eol */ +YY_RULE_SETUP +#line 305 "fortran.lex" +{ strcpy(yylval.na,fortran_text);return TOK_CHAR_CONSTANT; } + YY_BREAK +case 146: +/* rule 146 can match eol */ +YY_RULE_SETUP +#line 306 "fortran.lex" +{ strcpy(yylval.na,fortran_text);return TOK_CHAR_MESSAGE; } + YY_BREAK +case 147: +YY_RULE_SETUP +#line 307 "fortran.lex" +{ BEGIN(donottreat); } + YY_BREAK +case 148: +/* rule 148 can match eol */ +YY_RULE_SETUP +#line 308 "fortran.lex" +{ out_of_donottreat(); return '\n'; } + YY_BREAK +case 149: +/* rule 149 can match eol */ +YY_RULE_SETUP +#line 309 "fortran.lex" +{strcpy(yylval.na,fortran_text); removenewline(yylval.na); + return TOK_NAME; } + YY_BREAK +case 150: +YY_RULE_SETUP +#line 311 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return TOK_NAME; } + YY_BREAK +case 151: +YY_RULE_SETUP +#line 312 "fortran.lex" +{strcpy(yylval.na,fortran_text); return TOK_CSTREAL; } + YY_BREAK +case 152: +/* rule 152 can match eol */ +*yy_cp = (yy_hold_char); /* undo effects of setting up fortran_text */ +(yy_c_buf_p) = yy_cp -= 1; +YY_DO_BEFORE_ACTION; /* set up fortran_text again */ +YY_RULE_SETUP +#line 313 "fortran.lex" +{ // REAL1 + strcpy(yylval.na,fortran_text); return TOK_CSTREAL; } + YY_BREAK +case 153: +YY_RULE_SETUP +#line 315 "fortran.lex" +{ // REAL2 + strcpy(yylval.na,fortran_text); return TOK_CSTREAL; } + YY_BREAK +case 154: +YY_RULE_SETUP +#line 317 "fortran.lex" +{ strcpy(yylval.na,fortran_text); + if (lastwasendofstmt == 0) + return TOK_CSTINT; + else + if (testandextractfromlist(&List_Do_labels,fortran_text) == 1) + { + removefromlist(&List_Do_labels,yylval.na); + return TOK_LABEL_DJVIEW; + } + else + { + return TOK_LABEL; + } + } + YY_BREAK +case 155: +YY_RULE_SETUP +#line 331 "fortran.lex" +{} + YY_BREAK +case 156: +YY_RULE_SETUP +#line 332 "fortran.lex" +{} + YY_BREAK +case 157: +*yy_cp = (yy_hold_char); /* undo effects of setting up fortran_text */ +(yy_c_buf_p) = yy_cp = yy_bp + 1; +YY_DO_BEFORE_ACTION; /* set up fortran_text again */ +YY_RULE_SETUP +#line 333 "fortran.lex" +{ + in_complex_literal = -1; + return (int) *fortran_text; + } + YY_BREAK +case 158: +YY_RULE_SETUP +#line 337 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return (int) *fortran_text; } + YY_BREAK +case 159: +YY_RULE_SETUP +#line 338 "fortran.lex" +{ strcpy(yylval.na,fortran_text); return (int) *fortran_text; } + YY_BREAK +case 160: +YY_RULE_SETUP +#line 339 "fortran.lex" +{ lastwasendofstmt=1; token_since_endofstmt = 0; return TOK_SEMICOLON; } + YY_BREAK +case 161: +YY_RULE_SETUP +#line 340 "fortran.lex" +{ if (in_complex_literal==-1) {return TOK_COMMACOMPLEX; in_complex_literal=0;} else; return (int) *fortran_text; } + YY_BREAK +case 162: +YY_RULE_SETUP +#line 341 "fortran.lex" +{ return (int) *fortran_text; } + YY_BREAK +case 163: +YY_RULE_SETUP +#line 342 "fortran.lex" +{ return (int) *fortran_text; } + YY_BREAK +case 164: +YY_RULE_SETUP +#line 343 "fortran.lex" +{ return (int) *fortran_text; } + YY_BREAK +case 165: +/* rule 165 can match eol */ +YY_RULE_SETUP +#line 344 "fortran.lex" +{ INCREMENT_LINE_NUM() ; lastwasendofstmt=1; token_since_endofstmt = 0; increment_nbtokens = 0; return '\n'; } + YY_BREAK +case 166: +YY_RULE_SETUP +#line 345 "fortran.lex" +{increment_nbtokens = 0;} + YY_BREAK +case 167: +/* rule 167 can match eol */ +YY_RULE_SETUP +#line 346 "fortran.lex" +{ + return TOK_LABEL_FORMAT; } + YY_BREAK +case 168: +/* rule 168 can match eol */ +YY_RULE_SETUP +#line 348 "fortran.lex" +{return TOK_LABEL_FORMAT; } + YY_BREAK +case 169: +/* rule 169 can match eol */ +YY_RULE_SETUP +#line 349 "fortran.lex" +{ INCREMENT_LINE_NUM() ; newlinef90=1; } + YY_BREAK +case 170: +/* rule 170 can match eol */ +YY_RULE_SETUP +#line 350 "fortran.lex" +{ INCREMENT_LINE_NUM() ;} + YY_BREAK +case 171: +/* rule 171 can match eol */ +YY_RULE_SETUP +#line 352 "fortran.lex" +{ INCREMENT_LINE_NUM() ; BEGIN(donottreat); } + YY_BREAK +case 172: +/* rule 172 can match eol */ +YY_RULE_SETUP +#line 353 "fortran.lex" +{ out_of_donottreat(); return '\n'; } + YY_BREAK +case 173: +/* rule 173 can match eol */ +YY_RULE_SETUP +#line 354 "fortran.lex" +{ INCREMENT_LINE_NUM() ; } + YY_BREAK +case 174: +/* rule 174 can match eol */ +YY_RULE_SETUP +#line 355 "fortran.lex" +{ INCREMENT_LINE_NUM() ; increment_nbtokens = 0;} + YY_BREAK +case 175: +/* rule 175 can match eol */ +YY_RULE_SETUP +#line 356 "fortran.lex" +{ INCREMENT_LINE_NUM() ; increment_nbtokens = 0;} + YY_BREAK +case 176: +YY_RULE_SETUP +#line 357 "fortran.lex" +{increment_nbtokens = 0;} + YY_BREAK +case YY_STATE_EOF(INITIAL): +case YY_STATE_EOF(parameter): +case YY_STATE_EOF(character): +case YY_STATE_EOF(donottreat): +case YY_STATE_EOF(includestate): +case YY_STATE_EOF(fortran77style): +case YY_STATE_EOF(fortran90style): +#line 358 "fortran.lex" +{endoffile = 1; yyterminate();} + YY_BREAK +case 177: +YY_RULE_SETUP +#line 359 "fortran.lex" +ECHO; + YY_BREAK +#line 4749 "fortran.yy.c" + + case YY_END_OF_BUFFER: + { + /* Amount of text matched not including the EOB char. */ + int yy_amount_of_matched_text = (int) (yy_cp - (yytext_ptr)) - 1; + + /* Undo the effects of YY_DO_BEFORE_ACTION. */ + *yy_cp = (yy_hold_char); + YY_RESTORE_YY_MORE_OFFSET + + if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_NEW ) + { + /* We're scanning a new file or input source. It's + * possible that this happened because the user + * just pointed fortran_in at a new source and called + * fortran_lex(). If so, then we have to assure + * consistency between YY_CURRENT_BUFFER and our + * globals. Here is the right place to do so, because + * this is the first action (other than possibly a + * back-up) that will match for the new input source. + */ + (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars; + YY_CURRENT_BUFFER_LVALUE->yy_input_file = fortran_in; + YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_NORMAL; + } + + /* Note that here we test for yy_c_buf_p "<=" to the position + * of the first EOB in the buffer, since yy_c_buf_p will + * already have been incremented past the NUL character + * (since all states make transitions on EOB to the + * end-of-buffer state). Contrast this with the test + * in input(). + */ + if ( (yy_c_buf_p) <= &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] ) + { /* This was really a NUL. */ + yy_state_type yy_next_state; + + (yy_c_buf_p) = (yytext_ptr) + yy_amount_of_matched_text; + + yy_current_state = yy_get_previous_state( ); + + /* Okay, we're now positioned to make the NUL + * transition. We couldn't have + * yy_get_previous_state() go ahead and do it + * for us because it doesn't know how to deal + * with the possibility of jamming (and we don't + * want to build jamming into it because then it + * will run more slowly). + */ + + yy_next_state = yy_try_NUL_trans( yy_current_state ); + + yy_bp = (yytext_ptr) + YY_MORE_ADJ; + + if ( yy_next_state ) + { + /* Consume the NUL. */ + yy_cp = ++(yy_c_buf_p); + yy_current_state = yy_next_state; + goto yy_match; + } + + else + { + yy_cp = (yy_c_buf_p); + goto yy_find_action; + } + } + + else switch ( yy_get_next_buffer( ) ) + { + case EOB_ACT_END_OF_FILE: + { + (yy_did_buffer_switch_on_eof) = 0; + + if ( fortran_wrap( ) ) + { + /* Note: because we've taken care in + * yy_get_next_buffer() to have set up + * fortran_text, we can now set up + * yy_c_buf_p so that if some total + * hoser (like flex itself) wants to + * call the scanner after we return the + * YY_NULL, it'll still work - another + * YY_NULL will get returned. + */ + (yy_c_buf_p) = (yytext_ptr) + YY_MORE_ADJ; + + yy_act = YY_STATE_EOF(YY_START); + goto do_action; + } + + else + { + if ( ! (yy_did_buffer_switch_on_eof) ) + YY_NEW_FILE; + } + break; + } + + case EOB_ACT_CONTINUE_SCAN: + (yy_c_buf_p) = + (yytext_ptr) + yy_amount_of_matched_text; + + yy_current_state = yy_get_previous_state( ); + + yy_cp = (yy_c_buf_p); + yy_bp = (yytext_ptr) + YY_MORE_ADJ; + goto yy_match; + + case EOB_ACT_LAST_MATCH: + (yy_c_buf_p) = + &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)]; + + yy_current_state = yy_get_previous_state( ); + + yy_cp = (yy_c_buf_p); + yy_bp = (yytext_ptr) + YY_MORE_ADJ; + goto yy_find_action; + } + break; + } + + default: + YY_FATAL_ERROR( + "fatal flex scanner internal error--no action found" ); + } /* end of action switch */ + } /* end of scanning one token */ +} /* end of fortran_lex */ + +/* yy_get_next_buffer - try to read in a new buffer + * + * Returns a code representing an action: + * EOB_ACT_LAST_MATCH - + * EOB_ACT_CONTINUE_SCAN - continue scanning from current position + * EOB_ACT_END_OF_FILE - end of file + */ +static int yy_get_next_buffer (void) +{ + register char *dest = YY_CURRENT_BUFFER_LVALUE->yy_ch_buf; + register char *source = (yytext_ptr); + register int number_to_move, i; + int ret_val; + + if ( (yy_c_buf_p) > &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] ) + YY_FATAL_ERROR( + "fatal flex scanner internal error--end of buffer missed" ); + + if ( YY_CURRENT_BUFFER_LVALUE->yy_fill_buffer == 0 ) + { /* Don't try to fill the buffer, so this is an EOF. */ + if ( (yy_c_buf_p) - (yytext_ptr) - YY_MORE_ADJ == 1 ) + { + /* We matched a single character, the EOB, so + * treat this as a final EOF. + */ + return EOB_ACT_END_OF_FILE; + } + + else + { + /* We matched some text prior to the EOB, first + * process it. + */ + return EOB_ACT_LAST_MATCH; + } + } + + /* Try to read more data. */ + + /* First move last chars to start of buffer. */ + number_to_move = (int) ((yy_c_buf_p) - (yytext_ptr)) - 1; + + for ( i = 0; i < number_to_move; ++i ) + *(dest++) = *(source++); + + if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_EOF_PENDING ) + /* don't do the read, it's not guaranteed to return an EOF, + * just force an EOF + */ + YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars) = 0; + + else + { + yy_size_t num_to_read = + YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1; + + while ( num_to_read <= 0 ) + { /* Not enough room in the buffer - grow it. */ + + YY_FATAL_ERROR( +"input buffer overflow, can't enlarge buffer because scanner uses REJECT" ); + + } + + if ( num_to_read > YY_READ_BUF_SIZE ) + num_to_read = YY_READ_BUF_SIZE; + + /* Read in more data. */ + YY_INPUT( (&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]), + (yy_n_chars), num_to_read ); + + YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars); + } + + if ( (yy_n_chars) == 0 ) + { + if ( number_to_move == YY_MORE_ADJ ) + { + ret_val = EOB_ACT_END_OF_FILE; + fortran_restart(fortran_in ); + } + + else + { + ret_val = EOB_ACT_LAST_MATCH; + YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = + YY_BUFFER_EOF_PENDING; + } + } + + else + ret_val = EOB_ACT_CONTINUE_SCAN; + + if ((yy_size_t) ((yy_n_chars) + number_to_move) > YY_CURRENT_BUFFER_LVALUE->yy_buf_size) { + /* Extend the array by 50%, plus the number we really need. */ + yy_size_t new_size = (yy_n_chars) + number_to_move + ((yy_n_chars) >> 1); + YY_CURRENT_BUFFER_LVALUE->yy_ch_buf = (char *) fortran_realloc((void *) YY_CURRENT_BUFFER_LVALUE->yy_ch_buf,new_size ); + if ( ! YY_CURRENT_BUFFER_LVALUE->yy_ch_buf ) + YY_FATAL_ERROR( "out of dynamic memory in yy_get_next_buffer()" ); + } + + (yy_n_chars) += number_to_move; + YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] = YY_END_OF_BUFFER_CHAR; + YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] = YY_END_OF_BUFFER_CHAR; + + (yytext_ptr) = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[0]; + + return ret_val; +} + +/* yy_get_previous_state - get the state just before the EOB char was reached */ + + static yy_state_type yy_get_previous_state (void) +{ + register yy_state_type yy_current_state; + register char *yy_cp; + + yy_current_state = (yy_start); + yy_current_state += YY_AT_BOL(); + + (yy_state_ptr) = (yy_state_buf); + *(yy_state_ptr)++ = yy_current_state; + + for ( yy_cp = (yytext_ptr) + YY_MORE_ADJ; yy_cp < (yy_c_buf_p); ++yy_cp ) + { + register YY_CHAR yy_c = (*yy_cp ? yy_ec[YY_SC_TO_UI(*yy_cp)] : 1); + while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) + { + yy_current_state = (int) yy_def[yy_current_state]; + if ( yy_current_state >= 1855 ) + yy_c = yy_meta[(unsigned int) yy_c]; + } + yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c]; + *(yy_state_ptr)++ = yy_current_state; + } + + return yy_current_state; +} + +/* yy_try_NUL_trans - try to make a transition on the NUL character + * + * synopsis + * next_state = yy_try_NUL_trans( current_state ); + */ + static yy_state_type yy_try_NUL_trans (yy_state_type yy_current_state ) +{ + register int yy_is_jam; + + register YY_CHAR yy_c = 1; + while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) + { + yy_current_state = (int) yy_def[yy_current_state]; + if ( yy_current_state >= 1855 ) + yy_c = yy_meta[(unsigned int) yy_c]; + } + yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c]; + yy_is_jam = (yy_current_state == 1854); + if ( ! yy_is_jam ) + *(yy_state_ptr)++ = yy_current_state; + + return yy_is_jam ? 0 : yy_current_state; +} + + static void yyunput (int c, register char * yy_bp ) +{ + register char *yy_cp; + + yy_cp = (yy_c_buf_p); + + /* undo effects of setting up fortran_text */ + *yy_cp = (yy_hold_char); + + if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 ) + { /* need to shift things up to make room */ + /* +2 for EOB chars. */ + register yy_size_t number_to_move = (yy_n_chars) + 2; + register char *dest = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[ + YY_CURRENT_BUFFER_LVALUE->yy_buf_size + 2]; + register char *source = + &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]; + + while ( source > YY_CURRENT_BUFFER_LVALUE->yy_ch_buf ) + *--dest = *--source; + + yy_cp += (int) (dest - source); + yy_bp += (int) (dest - source); + YY_CURRENT_BUFFER_LVALUE->yy_n_chars = + (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_buf_size; + + if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 ) + YY_FATAL_ERROR( "flex scanner push-back overflow" ); + } + + *--yy_cp = (char) c; + + (yytext_ptr) = yy_bp; + (yy_hold_char) = *yy_cp; + (yy_c_buf_p) = yy_cp; +} + +#ifndef YY_NO_INPUT +#ifdef __cplusplus + static int yyinput (void) +#else + static int input (void) +#endif + +{ + int c; + + *(yy_c_buf_p) = (yy_hold_char); + + if ( *(yy_c_buf_p) == YY_END_OF_BUFFER_CHAR ) + { + /* yy_c_buf_p now points to the character we want to return. + * If this occurs *before* the EOB characters, then it's a + * valid NUL; if not, then we've hit the end of the buffer. + */ + if ( (yy_c_buf_p) < &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] ) + /* This was really a NUL. */ + *(yy_c_buf_p) = '\0'; + + else + { /* need more input */ + yy_size_t offset = (yy_c_buf_p) - (yytext_ptr); + ++(yy_c_buf_p); + + switch ( yy_get_next_buffer( ) ) + { + case EOB_ACT_LAST_MATCH: + /* This happens because yy_g_n_b() + * sees that we've accumulated a + * token and flags that we need to + * try matching the token before + * proceeding. But for input(), + * there's no matching to consider. + * So convert the EOB_ACT_LAST_MATCH + * to EOB_ACT_END_OF_FILE. + */ + + /* Reset buffer status. */ + fortran_restart(fortran_in ); + + /*FALLTHROUGH*/ + + case EOB_ACT_END_OF_FILE: + { + if ( fortran_wrap( ) ) + return 0; + + if ( ! (yy_did_buffer_switch_on_eof) ) + YY_NEW_FILE; +#ifdef __cplusplus + return yyinput(); +#else + return input(); +#endif + } + + case EOB_ACT_CONTINUE_SCAN: + (yy_c_buf_p) = (yytext_ptr) + offset; + break; + } + } + } + + c = *(unsigned char *) (yy_c_buf_p); /* cast for 8-bit char's */ + *(yy_c_buf_p) = '\0'; /* preserve fortran_text */ + (yy_hold_char) = *++(yy_c_buf_p); + + YY_CURRENT_BUFFER_LVALUE->yy_at_bol = (c == '\n'); + + return c; +} +#endif /* ifndef YY_NO_INPUT */ + +/** Immediately switch to a different input stream. + * @param input_file A readable stream. + * + * @note This function does not reset the start condition to @c INITIAL . + */ + void fortran_restart (FILE * input_file ) +{ + + if ( ! YY_CURRENT_BUFFER ){ + fortran_ensure_buffer_stack (); + YY_CURRENT_BUFFER_LVALUE = + fortran__create_buffer(fortran_in,YY_BUF_SIZE ); + } + + fortran__init_buffer(YY_CURRENT_BUFFER,input_file ); + fortran__load_buffer_state( ); +} + +/** Switch to a different input buffer. + * @param new_buffer The new input buffer. + * + */ + void fortran__switch_to_buffer (YY_BUFFER_STATE new_buffer ) +{ + + /* TODO. We should be able to replace this entire function body + * with + * fortran_pop_buffer_state(); + * fortran_push_buffer_state(new_buffer); + */ + fortran_ensure_buffer_stack (); + if ( YY_CURRENT_BUFFER == new_buffer ) + return; + + if ( YY_CURRENT_BUFFER ) + { + /* Flush out information for old buffer. */ + *(yy_c_buf_p) = (yy_hold_char); + YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p); + YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars); + } + + YY_CURRENT_BUFFER_LVALUE = new_buffer; + fortran__load_buffer_state( ); + + /* We don't actually know whether we did this switch during + * EOF (fortran_wrap()) processing, but the only time this flag + * is looked at is after fortran_wrap() is called, so it's safe + * to go ahead and always set it. + */ + (yy_did_buffer_switch_on_eof) = 1; +} + +static void fortran__load_buffer_state (void) +{ + (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars; + (yytext_ptr) = (yy_c_buf_p) = YY_CURRENT_BUFFER_LVALUE->yy_buf_pos; + fortran_in = YY_CURRENT_BUFFER_LVALUE->yy_input_file; + (yy_hold_char) = *(yy_c_buf_p); +} + +/** Allocate and initialize an input buffer state. + * @param file A readable stream. + * @param size The character buffer size in bytes. When in doubt, use @c YY_BUF_SIZE. + * + * @return the allocated buffer state. + */ + YY_BUFFER_STATE fortran__create_buffer (FILE * file, int size ) +{ + YY_BUFFER_STATE b; + + b = (YY_BUFFER_STATE) fortran_alloc(sizeof( struct yy_buffer_state ) ); + if ( ! b ) + YY_FATAL_ERROR( "out of dynamic memory in fortran__create_buffer()" ); + + b->yy_buf_size = size; + + /* yy_ch_buf has to be 2 characters longer than the size given because + * we need to put in 2 end-of-buffer characters. + */ + b->yy_ch_buf = (char *) fortran_alloc(b->yy_buf_size + 2 ); + if ( ! b->yy_ch_buf ) + YY_FATAL_ERROR( "out of dynamic memory in fortran__create_buffer()" ); + + b->yy_is_our_buffer = 1; + + fortran__init_buffer(b,file ); + + return b; +} + +/** Destroy the buffer. + * @param b a buffer created with fortran__create_buffer() + * + */ + void fortran__delete_buffer (YY_BUFFER_STATE b ) +{ + + if ( ! b ) + return; + + if ( b == YY_CURRENT_BUFFER ) /* Not sure if we should pop here. */ + YY_CURRENT_BUFFER_LVALUE = (YY_BUFFER_STATE) 0; + + if ( b->yy_is_our_buffer ) + fortran_free((void *) b->yy_ch_buf ); + + fortran_free((void *) b ); +} + +#ifndef __cplusplus +extern int isatty (int ); +#endif /* __cplusplus */ + +/* Initializes or reinitializes a buffer. + * This function is sometimes called more than once on the same buffer, + * such as during a fortran_restart() or at EOF. + */ + static void fortran__init_buffer (YY_BUFFER_STATE b, FILE * file ) + +{ + int oerrno = errno; + + fortran__flush_buffer(b ); + + b->yy_input_file = file; + b->yy_fill_buffer = 1; + + /* If b is the current buffer, then fortran__init_buffer was _probably_ + * called from fortran_restart() or through yy_get_next_buffer. + * In that case, we don't want to reset the lineno or column. + */ + if (b != YY_CURRENT_BUFFER){ + b->yy_bs_lineno = 1; + b->yy_bs_column = 0; + } + + b->yy_is_interactive = file ? (isatty( fileno(file) ) > 0) : 0; + + errno = oerrno; +} + +/** Discard all buffered characters. On the next scan, YY_INPUT will be called. + * @param b the buffer state to be flushed, usually @c YY_CURRENT_BUFFER. + * + */ + void fortran__flush_buffer (YY_BUFFER_STATE b ) +{ + if ( ! b ) + return; + + b->yy_n_chars = 0; + + /* We always need two end-of-buffer characters. The first causes + * a transition to the end-of-buffer state. The second causes + * a jam in that state. + */ + b->yy_ch_buf[0] = YY_END_OF_BUFFER_CHAR; + b->yy_ch_buf[1] = YY_END_OF_BUFFER_CHAR; + + b->yy_buf_pos = &b->yy_ch_buf[0]; + + b->yy_at_bol = 1; + b->yy_buffer_status = YY_BUFFER_NEW; + + if ( b == YY_CURRENT_BUFFER ) + fortran__load_buffer_state( ); +} + +/** Pushes the new state onto the stack. The new state becomes + * the current state. This function will allocate the stack + * if necessary. + * @param new_buffer The new state. + * + */ +void fortran_push_buffer_state (YY_BUFFER_STATE new_buffer ) +{ + if (new_buffer == NULL) + return; + + fortran_ensure_buffer_stack(); + + /* This block is copied from fortran__switch_to_buffer. */ + if ( YY_CURRENT_BUFFER ) + { + /* Flush out information for old buffer. */ + *(yy_c_buf_p) = (yy_hold_char); + YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p); + YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars); + } + + /* Only push if top exists. Otherwise, replace top. */ + if (YY_CURRENT_BUFFER) + (yy_buffer_stack_top)++; + YY_CURRENT_BUFFER_LVALUE = new_buffer; + + /* copied from fortran__switch_to_buffer. */ + fortran__load_buffer_state( ); + (yy_did_buffer_switch_on_eof) = 1; +} + +/** Removes and deletes the top of the stack, if present. + * The next element becomes the new top. + * + */ +void fortran_pop_buffer_state (void) +{ + if (!YY_CURRENT_BUFFER) + return; + + fortran__delete_buffer(YY_CURRENT_BUFFER ); + YY_CURRENT_BUFFER_LVALUE = NULL; + if ((yy_buffer_stack_top) > 0) + --(yy_buffer_stack_top); + + if (YY_CURRENT_BUFFER) { + fortran__load_buffer_state( ); + (yy_did_buffer_switch_on_eof) = 1; + } +} + +/* Allocates the stack if it does not exist. + * Guarantees space for at least one push. + */ +static void fortran_ensure_buffer_stack (void) +{ + yy_size_t num_to_alloc; + + if (!(yy_buffer_stack)) { + + /* First allocation is just for 2 elements, since we don't know if this + * scanner will even need a stack. We use 2 instead of 1 to avoid an + * immediate realloc on the next call. + */ + num_to_alloc = 1; + (yy_buffer_stack) = (struct yy_buffer_state**)fortran_alloc + (num_to_alloc * sizeof(struct yy_buffer_state*) + ); + if ( ! (yy_buffer_stack) ) + YY_FATAL_ERROR( "out of dynamic memory in fortran_ensure_buffer_stack()" ); + + memset((yy_buffer_stack), 0, num_to_alloc * sizeof(struct yy_buffer_state*)); + + (yy_buffer_stack_max) = num_to_alloc; + (yy_buffer_stack_top) = 0; + return; + } + + if ((yy_buffer_stack_top) >= ((yy_buffer_stack_max)) - 1){ + + /* Increase the buffer to prepare for a possible push. */ + int grow_size = 8 /* arbitrary grow size */; + + num_to_alloc = (yy_buffer_stack_max) + grow_size; + (yy_buffer_stack) = (struct yy_buffer_state**)fortran_realloc + ((yy_buffer_stack), + num_to_alloc * sizeof(struct yy_buffer_state*) + ); + if ( ! (yy_buffer_stack) ) + YY_FATAL_ERROR( "out of dynamic memory in fortran_ensure_buffer_stack()" ); + + /* zero only the new slots.*/ + memset((yy_buffer_stack) + (yy_buffer_stack_max), 0, grow_size * sizeof(struct yy_buffer_state*)); + (yy_buffer_stack_max) = num_to_alloc; + } +} + +/** Setup the input buffer state to scan directly from a user-specified character buffer. + * @param base the character buffer + * @param size the size in bytes of the character buffer + * + * @return the newly allocated buffer state object. + */ +YY_BUFFER_STATE fortran__scan_buffer (char * base, yy_size_t size ) +{ + YY_BUFFER_STATE b; + + if ( size < 2 || + base[size-2] != YY_END_OF_BUFFER_CHAR || + base[size-1] != YY_END_OF_BUFFER_CHAR ) + /* They forgot to leave room for the EOB's. */ + return 0; + + b = (YY_BUFFER_STATE) fortran_alloc(sizeof( struct yy_buffer_state ) ); + if ( ! b ) + YY_FATAL_ERROR( "out of dynamic memory in fortran__scan_buffer()" ); + + b->yy_buf_size = size - 2; /* "- 2" to take care of EOB's */ + b->yy_buf_pos = b->yy_ch_buf = base; + b->yy_is_our_buffer = 0; + b->yy_input_file = 0; + b->yy_n_chars = b->yy_buf_size; + b->yy_is_interactive = 0; + b->yy_at_bol = 1; + b->yy_fill_buffer = 0; + b->yy_buffer_status = YY_BUFFER_NEW; + + fortran__switch_to_buffer(b ); + + return b; +} + +/** Setup the input buffer state to scan a string. The next call to fortran_lex() will + * scan from a @e copy of @a str. + * @param yystr a NUL-terminated string to scan + * + * @return the newly allocated buffer state object. + * @note If you want to scan bytes that may contain NUL values, then use + * fortran__scan_bytes() instead. + */ +YY_BUFFER_STATE fortran__scan_string (yyconst char * yystr ) +{ + + return fortran__scan_bytes(yystr,strlen(yystr) ); +} + +/** Setup the input buffer state to scan the given bytes. The next call to fortran_lex() will + * scan from a @e copy of @a bytes. + * @param bytes the byte buffer to scan + * @param len the number of bytes in the buffer pointed to by @a bytes. + * + * @return the newly allocated buffer state object. + */ +YY_BUFFER_STATE fortran__scan_bytes (yyconst char * yybytes, yy_size_t _yybytes_len ) +{ + YY_BUFFER_STATE b; + char *buf; + yy_size_t n, i; + + /* Get memory for full buffer, including space for trailing EOB's. */ + n = _yybytes_len + 2; + buf = (char *) fortran_alloc(n ); + if ( ! buf ) + YY_FATAL_ERROR( "out of dynamic memory in fortran__scan_bytes()" ); + + for ( i = 0; i < _yybytes_len; ++i ) + buf[i] = yybytes[i]; + + buf[_yybytes_len] = buf[_yybytes_len+1] = YY_END_OF_BUFFER_CHAR; + + b = fortran__scan_buffer(buf,n ); + if ( ! b ) + YY_FATAL_ERROR( "bad buffer in fortran__scan_bytes()" ); + + /* It's okay to grow etc. this buffer, and we should throw it + * away when we're done. + */ + b->yy_is_our_buffer = 1; + + return b; +} + +#ifndef YY_EXIT_FAILURE +#define YY_EXIT_FAILURE 2 +#endif + +static void yy_fatal_error (yyconst char* msg ) +{ + (void) fprintf( stderr, "%s\n", msg ); + exit( YY_EXIT_FAILURE ); +} + +/* Redefine yyless() so it works in section 3 code. */ + +#undef yyless +#define yyless(n) \ + do \ + { \ + /* Undo effects of setting up fortran_text. */ \ + int yyless_macro_arg = (n); \ + YY_LESS_LINENO(yyless_macro_arg);\ + fortran_text[fortran_leng] = (yy_hold_char); \ + (yy_c_buf_p) = fortran_text + yyless_macro_arg; \ + (yy_hold_char) = *(yy_c_buf_p); \ + *(yy_c_buf_p) = '\0'; \ + fortran_leng = yyless_macro_arg; \ + } \ + while ( 0 ) + +/* Accessor methods (get/set functions) to struct members. */ + +/** Get the current line number. + * + */ +int fortran_get_lineno (void) +{ + + return fortran_lineno; +} + +/** Get the input stream. + * + */ +FILE *fortran_get_in (void) +{ + return fortran_in; +} + +/** Get the output stream. + * + */ +FILE *fortran_get_out (void) +{ + return fortran_out; +} + +/** Get the length of the current token. + * + */ +yy_size_t fortran_get_leng (void) +{ + return fortran_leng; +} + +/** Get the current token. + * + */ + +char *fortran_get_text (void) +{ + return fortran_text; +} + +/** Set the current line number. + * @param line_number + * + */ +void fortran_set_lineno (int line_number ) +{ + + fortran_lineno = line_number; +} + +/** Set the input stream. This does not discard the current + * input buffer. + * @param in_str A readable stream. + * + * @see fortran__switch_to_buffer + */ +void fortran_set_in (FILE * in_str ) +{ + fortran_in = in_str ; +} + +void fortran_set_out (FILE * out_str ) +{ + fortran_out = out_str ; +} + +int fortran_get_debug (void) +{ + return fortran__flex_debug; +} + +void fortran_set_debug (int bdebug ) +{ + fortran__flex_debug = bdebug ; +} + +static int yy_init_globals (void) +{ + /* Initialization is the same as for the non-reentrant scanner. + * This function is called from fortran_lex_destroy(), so don't allocate here. + */ + + (yy_buffer_stack) = 0; + (yy_buffer_stack_top) = 0; + (yy_buffer_stack_max) = 0; + (yy_c_buf_p) = (char *) 0; + (yy_init) = 0; + (yy_start) = 0; + + (yy_state_buf) = 0; + (yy_state_ptr) = 0; + (yy_full_match) = 0; + (yy_lp) = 0; + +/* Defined in main.c */ +#ifdef YY_STDINIT + fortran_in = stdin; + fortran_out = stdout; +#else + fortran_in = (FILE *) 0; + fortran_out = (FILE *) 0; +#endif + + /* For future reference: Set errno on error, since we are called by + * fortran_lex_init() + */ + return 0; +} + +/* fortran_lex_destroy is for both reentrant and non-reentrant scanners. */ +int fortran_lex_destroy (void) +{ + + /* Pop the buffer stack, destroying each element. */ + while(YY_CURRENT_BUFFER){ + fortran__delete_buffer(YY_CURRENT_BUFFER ); + YY_CURRENT_BUFFER_LVALUE = NULL; + fortran_pop_buffer_state(); + } + + /* Destroy the stack itself. */ + fortran_free((yy_buffer_stack) ); + (yy_buffer_stack) = NULL; + + fortran_free ( (yy_state_buf) ); + (yy_state_buf) = NULL; + + /* Reset the globals. This is important in a non-reentrant scanner so the next time + * fortran_lex() is called, initialization will occur. */ + yy_init_globals( ); + + return 0; +} + +/* + * Internal utility routines. + */ + +#ifndef yytext_ptr +static void yy_flex_strncpy (char* s1, yyconst char * s2, int n ) +{ + register int i; + for ( i = 0; i < n; ++i ) + s1[i] = s2[i]; +} +#endif + +#ifdef YY_NEED_STRLEN +static int yy_flex_strlen (yyconst char * s ) +{ + register int n; + for ( n = 0; s[n]; ++n ) + ; + + return n; +} +#endif + +void *fortran_alloc (yy_size_t size ) +{ + return (void *) malloc( size ); +} + +void *fortran_realloc (void * ptr, yy_size_t size ) +{ + /* The cast to (char *) in the following accommodates both + * implementations that use char* generic pointers, and those + * that use void* generic pointers. It works with the latter + * because both ANSI C and C++ allow castless assignment from + * any pointer type to void*, and deal with argument conversions + * as though doing an assignment. + */ + return (void *) realloc( (char *) ptr, size ); +} + +void fortran_free (void * ptr ) +{ + free( (char *) ptr ); /* see fortran_realloc() for (char *) cast */ +} + +#define YYTABLES_NAME "yytables" + +#line 359 "fortran.lex" + + + +void out_of_donottreat ( void ) +{ + BEGIN(INITIAL); + if (infixed) BEGIN(fortran77style) ; + if (infree) BEGIN(fortran90style) ; + INCREMENT_LINE_NUM() ; +} + diff --git a/CROCO/croco-v1.3.1/AGRIF/LIB/main.c b/CROCO/croco-v1.3.1/AGRIF/LIB/main.c new file mode 100644 index 00000000..38e17653 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/LIB/main.c @@ -0,0 +1,3959 @@ +/* A Bison parser, made by GNU Bison 2.7. */ + +/* Bison implementation for Yacc-like parsers in C + + Copyright (C) 1984, 1989-1990, 2000-2012 Free Software Foundation, Inc. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . */ + +/* As a special exception, you may create a larger work that contains + part or all of the Bison parser skeleton and distribute that work + under terms of your choice, so long as that work isn't itself a + parser generator using the skeleton or a modified version thereof + as a parser skeleton. Alternatively, if you modify or redistribute + the parser skeleton itself, you may (at your option) remove this + special exception, which will cause the skeleton and the resulting + Bison output files to be licensed under the GNU General Public + License without this special exception. + + This special exception was added by the Free Software Foundation in + version 2.2 of Bison. */ + +/* C LALR(1) parser skeleton written by Richard Stallman, by + simplifying the original so-called "semantic" parser. */ + +/* All symbols defined below should begin with yy or YY, to avoid + infringing on user name space. This should be done even for local + variables, as they might otherwise be expanded by user macros. + There are some unavoidable exceptions within include files to + define necessary library symbols; they are noted "INFRINGES ON + USER NAME SPACE" below. */ + +/* Identify Bison output. */ +#define YYBISON 1 + +/* Bison version. */ +#define YYBISON_VERSION "2.7" + +/* Skeleton name. */ +#define YYSKELETON_NAME "yacc.c" + +/* Pure parsers. */ +#define YYPURE 0 + +/* Push parsers. */ +#define YYPUSH 0 + +/* Pull parsers. */ +#define YYPULL 1 + + +/* Substitute the variable and function names. */ +#define yyparse convert_parse +#define yylex convert_lex +#define yyerror convert_error +#define yylval convert_lval +#define yychar convert_char +#define yydebug convert_debug +#define yynerrs convert_nerrs + +/* Copy the first part of user declarations. */ +/* Line 371 of yacc.c */ +#line 35 "convert.y" + +#include +#include +#include +#include "decl.h" + +int line_num=1; +extern FILE * convert_in; + +int convert_error(const char *s) +{ + printf("##\n## ERROR in conv: '%s' (line %d, file: %s)\n##\n", s, line_num, config_file); + exit(0); +} + + +/* Line 371 of yacc.c */ +#line 92 "convert.tab.c" + +# ifndef YY_NULL +# if defined __cplusplus && 201103L <= __cplusplus +# define YY_NULL nullptr +# else +# define YY_NULL 0 +# endif +# endif + +/* Enabling verbose error messages. */ +#ifdef YYERROR_VERBOSE +# undef YYERROR_VERBOSE +# define YYERROR_VERBOSE 1 +#else +# define YYERROR_VERBOSE 0 +#endif + + +/* Enabling traces. */ +#ifndef YYDEBUG +# define YYDEBUG 1 +#endif +#if YYDEBUG +extern int convert_debug; +#endif + +/* Tokens. */ +#ifndef YYTOKENTYPE +# define YYTOKENTYPE + /* Put the tokens into the symbol table, so that GDB and other debuggers + know about them. */ + enum yytokentype { + TOK_SEP = 258, + TOK_KIND = 259, + TOK_EQUAL = 260, + TOK_USE = 261, + TOK_MODULEMAIN = 262, + TOK_NOTGRIDDEP = 263, + TOK_USEITEM = 264, + TOK_NAME = 265, + TOK_CSTINT = 266, + TOK_PROBTYPE = 267 + }; +#endif + + +#if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED +typedef union YYSTYPE +{ +/* Line 387 of yacc.c */ +#line 52 "convert.y" + + char na[LONG_M]; + + +/* Line 387 of yacc.c */ +#line 149 "convert.tab.c" +} YYSTYPE; +# define YYSTYPE_IS_TRIVIAL 1 +# define yystype YYSTYPE /* obsolescent; will be withdrawn */ +# define YYSTYPE_IS_DECLARED 1 +#endif + +extern YYSTYPE convert_lval; + +#ifdef YYPARSE_PARAM +#if defined __STDC__ || defined __cplusplus +int convert_parse (void *YYPARSE_PARAM); +#else +int convert_parse (); +#endif +#else /* ! YYPARSE_PARAM */ +#if defined __STDC__ || defined __cplusplus +int convert_parse (void); +#else +int convert_parse (); +#endif +#endif /* ! YYPARSE_PARAM */ + + + +/* Copy the second part of user declarations. */ + +/* Line 390 of yacc.c */ +#line 177 "convert.tab.c" + +#ifdef short +# undef short +#endif + +#ifdef YYTYPE_UINT8 +typedef YYTYPE_UINT8 yytype_uint8; +#else +typedef unsigned char yytype_uint8; +#endif + +#ifdef YYTYPE_INT8 +typedef YYTYPE_INT8 yytype_int8; +#elif (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +typedef signed char yytype_int8; +#else +typedef short int yytype_int8; +#endif + +#ifdef YYTYPE_UINT16 +typedef YYTYPE_UINT16 yytype_uint16; +#else +typedef unsigned short int yytype_uint16; +#endif + +#ifdef YYTYPE_INT16 +typedef YYTYPE_INT16 yytype_int16; +#else +typedef short int yytype_int16; +#endif + +#ifndef YYSIZE_T +# ifdef __SIZE_TYPE__ +# define YYSIZE_T __SIZE_TYPE__ +# elif defined size_t +# define YYSIZE_T size_t +# elif ! defined YYSIZE_T && (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +# include /* INFRINGES ON USER NAME SPACE */ +# define YYSIZE_T size_t +# else +# define YYSIZE_T unsigned int +# endif +#endif + +#define YYSIZE_MAXIMUM ((YYSIZE_T) -1) + +#ifndef YY_ +# if defined YYENABLE_NLS && YYENABLE_NLS +# if ENABLE_NLS +# include /* INFRINGES ON USER NAME SPACE */ +# define YY_(Msgid) dgettext ("bison-runtime", Msgid) +# endif +# endif +# ifndef YY_ +# define YY_(Msgid) Msgid +# endif +#endif + +/* Suppress unused-variable warnings by "using" E. */ +#if ! defined lint || defined __GNUC__ +# define YYUSE(E) ((void) (E)) +#else +# define YYUSE(E) /* empty */ +#endif + +/* Identity function, used to suppress warnings about constant conditions. */ +#ifndef lint +# define YYID(N) (N) +#else +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +static int +YYID (int yyi) +#else +static int +YYID (yyi) + int yyi; +#endif +{ + return yyi; +} +#endif + +#if ! defined yyoverflow || YYERROR_VERBOSE + +/* The parser invokes alloca or malloc; define the necessary symbols. */ + +# ifdef YYSTACK_USE_ALLOCA +# if YYSTACK_USE_ALLOCA +# ifdef __GNUC__ +# define YYSTACK_ALLOC __builtin_alloca +# elif defined __BUILTIN_VA_ARG_INCR +# include /* INFRINGES ON USER NAME SPACE */ +# elif defined _AIX +# define YYSTACK_ALLOC __alloca +# elif defined _MSC_VER +# include /* INFRINGES ON USER NAME SPACE */ +# define alloca _alloca +# else +# define YYSTACK_ALLOC alloca +# if ! defined _ALLOCA_H && ! defined EXIT_SUCCESS && (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +# include /* INFRINGES ON USER NAME SPACE */ + /* Use EXIT_SUCCESS as a witness for stdlib.h. */ +# ifndef EXIT_SUCCESS +# define EXIT_SUCCESS 0 +# endif +# endif +# endif +# endif +# endif + +# ifdef YYSTACK_ALLOC + /* Pacify GCC's `empty if-body' warning. */ +# define YYSTACK_FREE(Ptr) do { /* empty */; } while (YYID (0)) +# ifndef YYSTACK_ALLOC_MAXIMUM + /* The OS might guarantee only one guard page at the bottom of the stack, + and a page size can be as small as 4096 bytes. So we cannot safely + invoke alloca (N) if N exceeds 4096. Use a slightly smaller number + to allow for a few compiler-allocated temporary stack slots. */ +# define YYSTACK_ALLOC_MAXIMUM 4032 /* reasonable circa 2006 */ +# endif +# else +# define YYSTACK_ALLOC YYMALLOC +# define YYSTACK_FREE YYFREE +# ifndef YYSTACK_ALLOC_MAXIMUM +# define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM +# endif +# if (defined __cplusplus && ! defined EXIT_SUCCESS \ + && ! ((defined YYMALLOC || defined malloc) \ + && (defined YYFREE || defined free))) +# include /* INFRINGES ON USER NAME SPACE */ +# ifndef EXIT_SUCCESS +# define EXIT_SUCCESS 0 +# endif +# endif +# ifndef YYMALLOC +# define YYMALLOC malloc +# if ! defined malloc && ! defined EXIT_SUCCESS && (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */ +# endif +# endif +# ifndef YYFREE +# define YYFREE free +# if ! defined free && ! defined EXIT_SUCCESS && (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +void free (void *); /* INFRINGES ON USER NAME SPACE */ +# endif +# endif +# endif +#endif /* ! defined yyoverflow || YYERROR_VERBOSE */ + + +#if (! defined yyoverflow \ + && (! defined __cplusplus \ + || (defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL))) + +/* A type that is properly aligned for any stack member. */ +union yyalloc +{ + yytype_int16 yyss_alloc; + YYSTYPE yyvs_alloc; +}; + +/* The size of the maximum gap between one aligned stack and the next. */ +# define YYSTACK_GAP_MAXIMUM (sizeof (union yyalloc) - 1) + +/* The size of an array large to enough to hold all stacks, each with + N elements. */ +# define YYSTACK_BYTES(N) \ + ((N) * (sizeof (yytype_int16) + sizeof (YYSTYPE)) \ + + YYSTACK_GAP_MAXIMUM) + +# define YYCOPY_NEEDED 1 + +/* Relocate STACK from its old location to the new one. The + local variables YYSIZE and YYSTACKSIZE give the old and new number of + elements in the stack, and YYPTR gives the new location of the + stack. Advance YYPTR to a properly aligned location for the next + stack. */ +# define YYSTACK_RELOCATE(Stack_alloc, Stack) \ + do \ + { \ + YYSIZE_T yynewbytes; \ + YYCOPY (&yyptr->Stack_alloc, Stack, yysize); \ + Stack = &yyptr->Stack_alloc; \ + yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \ + yyptr += yynewbytes / sizeof (*yyptr); \ + } \ + while (YYID (0)) + +#endif + +#if defined YYCOPY_NEEDED && YYCOPY_NEEDED +/* Copy COUNT objects from SRC to DST. The source and destination do + not overlap. */ +# ifndef YYCOPY +# if defined __GNUC__ && 1 < __GNUC__ +# define YYCOPY(Dst, Src, Count) \ + __builtin_memcpy (Dst, Src, (Count) * sizeof (*(Src))) +# else +# define YYCOPY(Dst, Src, Count) \ + do \ + { \ + YYSIZE_T yyi; \ + for (yyi = 0; yyi < (Count); yyi++) \ + (Dst)[yyi] = (Src)[yyi]; \ + } \ + while (YYID (0)) +# endif +# endif +#endif /* !YYCOPY_NEEDED */ + +/* YYFINAL -- State number of the termination state. */ +#define YYFINAL 2 +/* YYLAST -- Last index in YYTABLE. */ +#define YYLAST 29 + +/* YYNTOKENS -- Number of terminals. */ +#define YYNTOKENS 16 +/* YYNNTS -- Number of nonterminals. */ +#define YYNNTS 3 +/* YYNRULES -- Number of rules. */ +#define YYNRULES 11 +/* YYNRULES -- Number of states. */ +#define YYNSTATES 29 + +/* YYTRANSLATE(YYLEX) -- Bison symbol number corresponding to YYLEX. */ +#define YYUNDEFTOK 2 +#define YYMAXUTOK 267 + +#define YYTRANSLATE(YYX) \ + ((unsigned int) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK) + +/* YYTRANSLATE[YYLEX] -- Bison symbol number corresponding to YYLEX. */ +static const yytype_uint8 yytranslate[] = +{ + 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 15, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 13, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 14, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 1, 2, 3, 4, + 5, 6, 7, 8, 9, 10, 11, 12 +}; + +#if YYDEBUG +/* YYPRHS[YYN] -- Index of the first RHS symbol of rule number YYN in + YYRHS. */ +static const yytype_uint8 yyprhs[] = +{ + 0, 0, 3, 4, 7, 9, 13, 19, 27, 31, + 37, 42 +}; + +/* YYRHS -- A `-1'-separated list of the rules' RHS. */ +static const yytype_int8 yyrhs[] = +{ + 17, 0, -1, -1, 17, 18, -1, 15, -1, 12, + 10, 14, -1, 12, 10, 13, 10, 14, -1, 12, + 10, 13, 10, 13, 10, 14, -1, 7, 10, 14, + -1, 4, 10, 5, 11, 14, -1, 8, 3, 10, + 14, -1, 6, 9, 14, -1 +}; + +/* YYRLINE[YYN] -- source line where rule number YYN was defined. */ +static const yytype_uint8 yyrline[] = +{ + 0, 71, 71, 72, 75, 76, 77, 78, 79, 84, + 100, 104 +}; +#endif + +#if YYDEBUG || YYERROR_VERBOSE || 0 +/* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM. + First, the terminals, then, starting at YYNTOKENS, nonterminals. */ +static const char *const yytname[] = +{ + "$end", "error", "$undefined", "TOK_SEP", "TOK_KIND", "TOK_EQUAL", + "TOK_USE", "TOK_MODULEMAIN", "TOK_NOTGRIDDEP", "TOK_USEITEM", "TOK_NAME", + "TOK_CSTINT", "TOK_PROBTYPE", "','", "';'", "'\\n'", "$accept", "input", + "line", YY_NULL +}; +#endif + +# ifdef YYPRINT +/* YYTOKNUM[YYLEX-NUM] -- Internal token number corresponding to + token YYLEX-NUM. */ +static const yytype_uint16 yytoknum[] = +{ + 0, 256, 257, 258, 259, 260, 261, 262, 263, 264, + 265, 266, 267, 44, 59, 10 +}; +# endif + +/* YYR1[YYN] -- Symbol number of symbol that rule YYN derives. */ +static const yytype_uint8 yyr1[] = +{ + 0, 16, 17, 17, 18, 18, 18, 18, 18, 18, + 18, 18 +}; + +/* YYR2[YYN] -- Number of symbols composing right hand side of rule YYN. */ +static const yytype_uint8 yyr2[] = +{ + 0, 2, 0, 2, 1, 3, 5, 7, 3, 5, + 4, 3 +}; + +/* YYDEFACT[STATE-NAME] -- Default reduction number in state STATE-NUM. + Performed when YYTABLE doesn't specify something else to do. Zero + means the default is an error. */ +static const yytype_uint8 yydefact[] = +{ + 2, 0, 1, 0, 0, 0, 0, 0, 4, 3, + 0, 0, 0, 0, 0, 0, 11, 8, 0, 0, + 5, 0, 10, 0, 9, 0, 6, 0, 7 +}; + +/* YYDEFGOTO[NTERM-NUM]. */ +static const yytype_int8 yydefgoto[] = +{ + -1, 1, 9 +}; + +/* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing + STATE-NUM. */ +#define YYPACT_NINF -13 +static const yytype_int8 yypact[] = +{ + -13, 0, -13, -7, 2, -5, 10, 4, -13, -13, + 11, 3, 5, 8, -12, 9, -13, -13, 7, 12, + -13, 13, -13, -4, -13, 14, -13, 15, -13 +}; + +/* YYPGOTO[NTERM-NUM]. */ +static const yytype_int8 yypgoto[] = +{ + -13, -13, -13 +}; + +/* YYTABLE[YYPACT[STATE-NUM]]. What to do in state STATE-NUM. If + positive, shift that token. If negative, reduce the rule which + number is the opposite. If YYTABLE_NINF, syntax error. */ +#define YYTABLE_NINF -1 +static const yytype_uint8 yytable[] = +{ + 2, 19, 20, 10, 3, 12, 4, 5, 6, 25, + 26, 11, 7, 13, 14, 8, 15, 16, 18, 17, + 21, 22, 23, 0, 27, 0, 0, 24, 0, 28 +}; + +#define yypact_value_is_default(Yystate) \ + (!!((Yystate) == (-13))) + +#define yytable_value_is_error(Yytable_value) \ + YYID (0) + +static const yytype_int8 yycheck[] = +{ + 0, 13, 14, 10, 4, 10, 6, 7, 8, 13, + 14, 9, 12, 3, 10, 15, 5, 14, 10, 14, + 11, 14, 10, -1, 10, -1, -1, 14, -1, 14 +}; + +/* YYSTOS[STATE-NUM] -- The (internal number of the) accessing + symbol of state STATE-NUM. */ +static const yytype_uint8 yystos[] = +{ + 0, 17, 0, 4, 6, 7, 8, 12, 15, 18, + 10, 9, 10, 3, 10, 5, 14, 14, 10, 13, + 14, 11, 14, 10, 14, 13, 14, 10, 14 +}; + +#define yyerrok (yyerrstatus = 0) +#define yyclearin (yychar = YYEMPTY) +#define YYEMPTY (-2) +#define YYEOF 0 + +#define YYACCEPT goto yyacceptlab +#define YYABORT goto yyabortlab +#define YYERROR goto yyerrorlab + + +/* Like YYERROR except do call yyerror. This remains here temporarily + to ease the transition to the new meaning of YYERROR, for GCC. + Once GCC version 2 has supplanted version 1, this can go. However, + YYFAIL appears to be in use. Nevertheless, it is formally deprecated + in Bison 2.4.2's NEWS entry, where a plan to phase it out is + discussed. */ + +#define YYFAIL goto yyerrlab +#if defined YYFAIL + /* This is here to suppress warnings from the GCC cpp's + -Wunused-macros. Normally we don't worry about that warning, but + some users do, and we want to make it easy for users to remove + YYFAIL uses, which will produce warnings from Bison 2.5. */ +#endif + +#define YYRECOVERING() (!!yyerrstatus) + +#define YYBACKUP(Token, Value) \ +do \ + if (yychar == YYEMPTY) \ + { \ + yychar = (Token); \ + yylval = (Value); \ + YYPOPSTACK (yylen); \ + yystate = *yyssp; \ + goto yybackup; \ + } \ + else \ + { \ + yyerror (YY_("syntax error: cannot back up")); \ + YYERROR; \ + } \ +while (YYID (0)) + +/* Error token number */ +#define YYTERROR 1 +#define YYERRCODE 256 + + +/* This macro is provided for backward compatibility. */ +#ifndef YY_LOCATION_PRINT +# define YY_LOCATION_PRINT(File, Loc) ((void) 0) +#endif + + +/* YYLEX -- calling `yylex' with the right arguments. */ +#ifdef YYLEX_PARAM +# define YYLEX yylex (YYLEX_PARAM) +#else +# define YYLEX yylex () +#endif + +/* Enable debugging if requested. */ +#if YYDEBUG + +# ifndef YYFPRINTF +# include /* INFRINGES ON USER NAME SPACE */ +# define YYFPRINTF fprintf +# endif + +# define YYDPRINTF(Args) \ +do { \ + if (yydebug) \ + YYFPRINTF Args; \ +} while (YYID (0)) + +# define YY_SYMBOL_PRINT(Title, Type, Value, Location) \ +do { \ + if (yydebug) \ + { \ + YYFPRINTF (stderr, "%s ", Title); \ + yy_symbol_print (stderr, \ + Type, Value); \ + YYFPRINTF (stderr, "\n"); \ + } \ +} while (YYID (0)) + + +/*--------------------------------. +| Print this symbol on YYOUTPUT. | +`--------------------------------*/ + +/*ARGSUSED*/ +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +static void +yy_symbol_value_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep) +#else +static void +yy_symbol_value_print (yyoutput, yytype, yyvaluep) + FILE *yyoutput; + int yytype; + YYSTYPE const * const yyvaluep; +#endif +{ + FILE *yyo = yyoutput; + YYUSE (yyo); + if (!yyvaluep) + return; +# ifdef YYPRINT + if (yytype < YYNTOKENS) + YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep); +# else + YYUSE (yyoutput); +# endif + switch (yytype) + { + default: + break; + } +} + + +/*--------------------------------. +| Print this symbol on YYOUTPUT. | +`--------------------------------*/ + +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +static void +yy_symbol_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep) +#else +static void +yy_symbol_print (yyoutput, yytype, yyvaluep) + FILE *yyoutput; + int yytype; + YYSTYPE const * const yyvaluep; +#endif +{ + if (yytype < YYNTOKENS) + YYFPRINTF (yyoutput, "token %s (", yytname[yytype]); + else + YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]); + + yy_symbol_value_print (yyoutput, yytype, yyvaluep); + YYFPRINTF (yyoutput, ")"); +} + +/*------------------------------------------------------------------. +| yy_stack_print -- Print the state stack from its BOTTOM up to its | +| TOP (included). | +`------------------------------------------------------------------*/ + +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +static void +yy_stack_print (yytype_int16 *yybottom, yytype_int16 *yytop) +#else +static void +yy_stack_print (yybottom, yytop) + yytype_int16 *yybottom; + yytype_int16 *yytop; +#endif +{ + YYFPRINTF (stderr, "Stack now"); + for (; yybottom <= yytop; yybottom++) + { + int yybot = *yybottom; + YYFPRINTF (stderr, " %d", yybot); + } + YYFPRINTF (stderr, "\n"); +} + +# define YY_STACK_PRINT(Bottom, Top) \ +do { \ + if (yydebug) \ + yy_stack_print ((Bottom), (Top)); \ +} while (YYID (0)) + + +/*------------------------------------------------. +| Report that the YYRULE is going to be reduced. | +`------------------------------------------------*/ + +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +static void +yy_reduce_print (YYSTYPE *yyvsp, int yyrule) +#else +static void +yy_reduce_print (yyvsp, yyrule) + YYSTYPE *yyvsp; + int yyrule; +#endif +{ + int yynrhs = yyr2[yyrule]; + int yyi; + unsigned long int yylno = yyrline[yyrule]; + YYFPRINTF (stderr, "Reducing stack by rule %d (line %lu):\n", + yyrule - 1, yylno); + /* The symbols being reduced. */ + for (yyi = 0; yyi < yynrhs; yyi++) + { + YYFPRINTF (stderr, " $%d = ", yyi + 1); + yy_symbol_print (stderr, yyrhs[yyprhs[yyrule] + yyi], + &(yyvsp[(yyi + 1) - (yynrhs)]) + ); + YYFPRINTF (stderr, "\n"); + } +} + +# define YY_REDUCE_PRINT(Rule) \ +do { \ + if (yydebug) \ + yy_reduce_print (yyvsp, Rule); \ +} while (YYID (0)) + +/* Nonzero means print parse trace. It is left uninitialized so that + multiple parsers can coexist. */ +int yydebug; +#else /* !YYDEBUG */ +# define YYDPRINTF(Args) +# define YY_SYMBOL_PRINT(Title, Type, Value, Location) +# define YY_STACK_PRINT(Bottom, Top) +# define YY_REDUCE_PRINT(Rule) +#endif /* !YYDEBUG */ + + +/* YYINITDEPTH -- initial size of the parser's stacks. */ +#ifndef YYINITDEPTH +# define YYINITDEPTH 200 +#endif + +/* YYMAXDEPTH -- maximum size the stacks can grow to (effective only + if the built-in stack extension method is used). + + Do not make this value too large; the results are undefined if + YYSTACK_ALLOC_MAXIMUM < YYSTACK_BYTES (YYMAXDEPTH) + evaluated with infinite-precision integer arithmetic. */ + +#ifndef YYMAXDEPTH +# define YYMAXDEPTH 10000 +#endif + + +#if YYERROR_VERBOSE + +# ifndef yystrlen +# if defined __GLIBC__ && defined _STRING_H +# define yystrlen strlen +# else +/* Return the length of YYSTR. */ +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +static YYSIZE_T +yystrlen (const char *yystr) +#else +static YYSIZE_T +yystrlen (yystr) + const char *yystr; +#endif +{ + YYSIZE_T yylen; + for (yylen = 0; yystr[yylen]; yylen++) + continue; + return yylen; +} +# endif +# endif + +# ifndef yystpcpy +# if defined __GLIBC__ && defined _STRING_H && defined _GNU_SOURCE +# define yystpcpy stpcpy +# else +/* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in + YYDEST. */ +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +static char * +yystpcpy (char *yydest, const char *yysrc) +#else +static char * +yystpcpy (yydest, yysrc) + char *yydest; + const char *yysrc; +#endif +{ + char *yyd = yydest; + const char *yys = yysrc; + + while ((*yyd++ = *yys++) != '\0') + continue; + + return yyd - 1; +} +# endif +# endif + +# ifndef yytnamerr +/* Copy to YYRES the contents of YYSTR after stripping away unnecessary + quotes and backslashes, so that it's suitable for yyerror. The + heuristic is that double-quoting is unnecessary unless the string + contains an apostrophe, a comma, or backslash (other than + backslash-backslash). YYSTR is taken from yytname. If YYRES is + null, do not copy; instead, return the length of what the result + would have been. */ +static YYSIZE_T +yytnamerr (char *yyres, const char *yystr) +{ + if (*yystr == '"') + { + YYSIZE_T yyn = 0; + char const *yyp = yystr; + + for (;;) + switch (*++yyp) + { + case '\'': + case ',': + goto do_not_strip_quotes; + + case '\\': + if (*++yyp != '\\') + goto do_not_strip_quotes; + /* Fall through. */ + default: + if (yyres) + yyres[yyn] = *yyp; + yyn++; + break; + + case '"': + if (yyres) + yyres[yyn] = '\0'; + return yyn; + } + do_not_strip_quotes: ; + } + + if (! yyres) + return yystrlen (yystr); + + return yystpcpy (yyres, yystr) - yyres; +} +# endif + +/* Copy into *YYMSG, which is of size *YYMSG_ALLOC, an error message + about the unexpected token YYTOKEN for the state stack whose top is + YYSSP. + + Return 0 if *YYMSG was successfully written. Return 1 if *YYMSG is + not large enough to hold the message. In that case, also set + *YYMSG_ALLOC to the required number of bytes. Return 2 if the + required number of bytes is too large to store. */ +static int +yysyntax_error (YYSIZE_T *yymsg_alloc, char **yymsg, + yytype_int16 *yyssp, int yytoken) +{ + YYSIZE_T yysize0 = yytnamerr (YY_NULL, yytname[yytoken]); + YYSIZE_T yysize = yysize0; + enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 }; + /* Internationalized format string. */ + const char *yyformat = YY_NULL; + /* Arguments of yyformat. */ + char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM]; + /* Number of reported tokens (one for the "unexpected", one per + "expected"). */ + int yycount = 0; + + /* There are many possibilities here to consider: + - Assume YYFAIL is not used. It's too flawed to consider. See + + for details. YYERROR is fine as it does not invoke this + function. + - If this state is a consistent state with a default action, then + the only way this function was invoked is if the default action + is an error action. In that case, don't check for expected + tokens because there are none. + - The only way there can be no lookahead present (in yychar) is if + this state is a consistent state with a default action. Thus, + detecting the absence of a lookahead is sufficient to determine + that there is no unexpected or expected token to report. In that + case, just report a simple "syntax error". + - Don't assume there isn't a lookahead just because this state is a + consistent state with a default action. There might have been a + previous inconsistent state, consistent state with a non-default + action, or user semantic action that manipulated yychar. + - Of course, the expected token list depends on states to have + correct lookahead information, and it depends on the parser not + to perform extra reductions after fetching a lookahead from the + scanner and before detecting a syntax error. Thus, state merging + (from LALR or IELR) and default reductions corrupt the expected + token list. However, the list is correct for canonical LR with + one exception: it will still contain any token that will not be + accepted due to an error action in a later state. + */ + if (yytoken != YYEMPTY) + { + int yyn = yypact[*yyssp]; + yyarg[yycount++] = yytname[yytoken]; + if (!yypact_value_is_default (yyn)) + { + /* Start YYX at -YYN if negative to avoid negative indexes in + YYCHECK. In other words, skip the first -YYN actions for + this state because they are default actions. */ + int yyxbegin = yyn < 0 ? -yyn : 0; + /* Stay within bounds of both yycheck and yytname. */ + int yychecklim = YYLAST - yyn + 1; + int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS; + int yyx; + + for (yyx = yyxbegin; yyx < yyxend; ++yyx) + if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR + && !yytable_value_is_error (yytable[yyx + yyn])) + { + if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM) + { + yycount = 1; + yysize = yysize0; + break; + } + yyarg[yycount++] = yytname[yyx]; + { + YYSIZE_T yysize1 = yysize + yytnamerr (YY_NULL, yytname[yyx]); + if (! (yysize <= yysize1 + && yysize1 <= YYSTACK_ALLOC_MAXIMUM)) + return 2; + yysize = yysize1; + } + } + } + } + + switch (yycount) + { +# define YYCASE_(N, S) \ + case N: \ + yyformat = S; \ + break + YYCASE_(0, YY_("syntax error")); + YYCASE_(1, YY_("syntax error, unexpected %s")); + YYCASE_(2, YY_("syntax error, unexpected %s, expecting %s")); + YYCASE_(3, YY_("syntax error, unexpected %s, expecting %s or %s")); + YYCASE_(4, YY_("syntax error, unexpected %s, expecting %s or %s or %s")); + YYCASE_(5, YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s")); +# undef YYCASE_ + } + + { + YYSIZE_T yysize1 = yysize + yystrlen (yyformat); + if (! (yysize <= yysize1 && yysize1 <= YYSTACK_ALLOC_MAXIMUM)) + return 2; + yysize = yysize1; + } + + if (*yymsg_alloc < yysize) + { + *yymsg_alloc = 2 * yysize; + if (! (yysize <= *yymsg_alloc + && *yymsg_alloc <= YYSTACK_ALLOC_MAXIMUM)) + *yymsg_alloc = YYSTACK_ALLOC_MAXIMUM; + return 1; + } + + /* Avoid sprintf, as that infringes on the user's name space. + Don't have undefined behavior even if the translation + produced a string with the wrong number of "%s"s. */ + { + char *yyp = *yymsg; + int yyi = 0; + while ((*yyp = *yyformat) != '\0') + if (*yyp == '%' && yyformat[1] == 's' && yyi < yycount) + { + yyp += yytnamerr (yyp, yyarg[yyi++]); + yyformat += 2; + } + else + { + yyp++; + yyformat++; + } + } + return 0; +} +#endif /* YYERROR_VERBOSE */ + +/*-----------------------------------------------. +| Release the memory associated to this symbol. | +`-----------------------------------------------*/ + +/*ARGSUSED*/ +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +static void +yydestruct (const char *yymsg, int yytype, YYSTYPE *yyvaluep) +#else +static void +yydestruct (yymsg, yytype, yyvaluep) + const char *yymsg; + int yytype; + YYSTYPE *yyvaluep; +#endif +{ + YYUSE (yyvaluep); + + if (!yymsg) + yymsg = "Deleting"; + YY_SYMBOL_PRINT (yymsg, yytype, yyvaluep, yylocationp); + + switch (yytype) + { + + default: + break; + } +} + + + + +/* The lookahead symbol. */ +int yychar; + + +#ifndef YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN +# define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN +# define YY_IGNORE_MAYBE_UNINITIALIZED_END +#endif +#ifndef YY_INITIAL_VALUE +# define YY_INITIAL_VALUE(Value) /* Nothing. */ +#endif + +/* The semantic value of the lookahead symbol. */ +YYSTYPE yylval YY_INITIAL_VALUE(yyval_default); + +/* Number of syntax errors so far. */ +int yynerrs; + + +/*----------. +| yyparse. | +`----------*/ + +#ifdef YYPARSE_PARAM +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +int +yyparse (void *YYPARSE_PARAM) +#else +int +yyparse (YYPARSE_PARAM) + void *YYPARSE_PARAM; +#endif +#else /* ! YYPARSE_PARAM */ +#if (defined __STDC__ || defined __C99__FUNC__ \ + || defined __cplusplus || defined _MSC_VER) +int +yyparse (void) +#else +int +yyparse () + +#endif +#endif +{ + int yystate; + /* Number of tokens to shift before error messages enabled. */ + int yyerrstatus; + + /* The stacks and their tools: + `yyss': related to states. + `yyvs': related to semantic values. + + Refer to the stacks through separate pointers, to allow yyoverflow + to reallocate them elsewhere. */ + + /* The state stack. */ + yytype_int16 yyssa[YYINITDEPTH]; + yytype_int16 *yyss; + yytype_int16 *yyssp; + + /* The semantic value stack. */ + YYSTYPE yyvsa[YYINITDEPTH]; + YYSTYPE *yyvs; + YYSTYPE *yyvsp; + + YYSIZE_T yystacksize; + + int yyn; + int yyresult; + /* Lookahead token as an internal (translated) token number. */ + int yytoken = 0; + /* The variables used to return semantic value and location from the + action routines. */ + YYSTYPE yyval; + +#if YYERROR_VERBOSE + /* Buffer for error messages, and its allocated size. */ + char yymsgbuf[128]; + char *yymsg = yymsgbuf; + YYSIZE_T yymsg_alloc = sizeof yymsgbuf; +#endif + +#define YYPOPSTACK(N) (yyvsp -= (N), yyssp -= (N)) + + /* The number of symbols on the RHS of the reduced rule. + Keep to zero when no symbol should be popped. */ + int yylen = 0; + + yyssp = yyss = yyssa; + yyvsp = yyvs = yyvsa; + yystacksize = YYINITDEPTH; + + YYDPRINTF ((stderr, "Starting parse\n")); + + yystate = 0; + yyerrstatus = 0; + yynerrs = 0; + yychar = YYEMPTY; /* Cause a token to be read. */ + goto yysetstate; + +/*------------------------------------------------------------. +| yynewstate -- Push a new state, which is found in yystate. | +`------------------------------------------------------------*/ + yynewstate: + /* In all cases, when you get here, the value and location stacks + have just been pushed. So pushing a state here evens the stacks. */ + yyssp++; + + yysetstate: + *yyssp = yystate; + + if (yyss + yystacksize - 1 <= yyssp) + { + /* Get the current used size of the three stacks, in elements. */ + YYSIZE_T yysize = yyssp - yyss + 1; + +#ifdef yyoverflow + { + /* Give user a chance to reallocate the stack. Use copies of + these so that the &'s don't force the real ones into + memory. */ + YYSTYPE *yyvs1 = yyvs; + yytype_int16 *yyss1 = yyss; + + /* Each stack pointer address is followed by the size of the + data in use in that stack, in bytes. This used to be a + conditional around just the two extra args, but that might + be undefined if yyoverflow is a macro. */ + yyoverflow (YY_("memory exhausted"), + &yyss1, yysize * sizeof (*yyssp), + &yyvs1, yysize * sizeof (*yyvsp), + &yystacksize); + + yyss = yyss1; + yyvs = yyvs1; + } +#else /* no yyoverflow */ +# ifndef YYSTACK_RELOCATE + goto yyexhaustedlab; +# else + /* Extend the stack our own way. */ + if (YYMAXDEPTH <= yystacksize) + goto yyexhaustedlab; + yystacksize *= 2; + if (YYMAXDEPTH < yystacksize) + yystacksize = YYMAXDEPTH; + + { + yytype_int16 *yyss1 = yyss; + union yyalloc *yyptr = + (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize)); + if (! yyptr) + goto yyexhaustedlab; + YYSTACK_RELOCATE (yyss_alloc, yyss); + YYSTACK_RELOCATE (yyvs_alloc, yyvs); +# undef YYSTACK_RELOCATE + if (yyss1 != yyssa) + YYSTACK_FREE (yyss1); + } +# endif +#endif /* no yyoverflow */ + + yyssp = yyss + yysize - 1; + yyvsp = yyvs + yysize - 1; + + YYDPRINTF ((stderr, "Stack size increased to %lu\n", + (unsigned long int) yystacksize)); + + if (yyss + yystacksize - 1 <= yyssp) + YYABORT; + } + + YYDPRINTF ((stderr, "Entering state %d\n", yystate)); + + if (yystate == YYFINAL) + YYACCEPT; + + goto yybackup; + +/*-----------. +| yybackup. | +`-----------*/ +yybackup: + + /* Do appropriate processing given the current state. Read a + lookahead token if we need one and don't already have one. */ + + /* First try to decide what to do without reference to lookahead token. */ + yyn = yypact[yystate]; + if (yypact_value_is_default (yyn)) + goto yydefault; + + /* Not known => get a lookahead token if don't already have one. */ + + /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */ + if (yychar == YYEMPTY) + { + YYDPRINTF ((stderr, "Reading a token: ")); + yychar = YYLEX; + } + + if (yychar <= YYEOF) + { + yychar = yytoken = YYEOF; + YYDPRINTF ((stderr, "Now at end of input.\n")); + } + else + { + yytoken = YYTRANSLATE (yychar); + YY_SYMBOL_PRINT ("Next token is", yytoken, &yylval, &yylloc); + } + + /* If the proper action on seeing token YYTOKEN is to reduce or to + detect an error, take that action. */ + yyn += yytoken; + if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken) + goto yydefault; + yyn = yytable[yyn]; + if (yyn <= 0) + { + if (yytable_value_is_error (yyn)) + goto yyerrlab; + yyn = -yyn; + goto yyreduce; + } + + /* Count tokens shifted since error; after three, turn off error + status. */ + if (yyerrstatus) + yyerrstatus--; + + /* Shift the lookahead token. */ + YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc); + + /* Discard the shifted token. */ + yychar = YYEMPTY; + + yystate = yyn; + YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN + *++yyvsp = yylval; + YY_IGNORE_MAYBE_UNINITIALIZED_END + + goto yynewstate; + + +/*-----------------------------------------------------------. +| yydefault -- do the default action for the current state. | +`-----------------------------------------------------------*/ +yydefault: + yyn = yydefact[yystate]; + if (yyn == 0) + goto yyerrlab; + goto yyreduce; + + +/*-----------------------------. +| yyreduce -- Do a reduction. | +`-----------------------------*/ +yyreduce: + /* yyn is the number of a rule to reduce with. */ + yylen = yyr2[yyn]; + + /* If YYLEN is nonzero, implement the default value of the action: + `$$ = $1'. + + Otherwise, the following line sets YYVAL to garbage. + This behavior is undocumented and Bison + users should not rely upon it. Assigning to YYVAL + unconditionally makes the parser a bit smaller, and it avoids a + GCC warning that YYVAL may be used uninitialized. */ + yyval = yyvsp[1-yylen]; + + + YY_REDUCE_PRINT (yyn); + switch (yyn) + { + case 5: +/* Line 1807 of yacc.c */ +#line 76 "convert.y" + { initdimprob(1,(yyvsp[(2) - (3)].na),"0","0"); } + break; + + case 6: +/* Line 1807 of yacc.c */ +#line 77 "convert.y" + { initdimprob(2,(yyvsp[(2) - (5)].na), (yyvsp[(4) - (5)].na),"0"); } + break; + + case 7: +/* Line 1807 of yacc.c */ +#line 78 "convert.y" + { initdimprob(3,(yyvsp[(2) - (7)].na), (yyvsp[(4) - (7)].na), (yyvsp[(6) - (7)].na)); } + break; + + case 8: +/* Line 1807 of yacc.c */ +#line 80 "convert.y" + { + listofmodules = Addtolistnom((yyvsp[(2) - (3)].na),listofmodules,0); + Addmoduletothelist((yyvsp[(2) - (3)].na)); + } + break; + + case 9: +/* Line 1807 of yacc.c */ +#line 85 "convert.y" + { + if (!strcasecmp((yyvsp[(4) - (5)].na),"4")) + { + listofkind = Addtolistnom((yyvsp[(2) - (5)].na),listofkind,4); + } + else if (!strcasecmp((yyvsp[(4) - (5)].na),"8")) + { + listofkind = Addtolistnom((yyvsp[(2) - (5)].na),listofkind,8); + } + else + { + printf("##\n## Unknown kind type : %s (must be 4 or 8)\n##",(yyvsp[(4) - (5)].na)); + exit(0); + } + } + break; + + case 10: +/* Line 1807 of yacc.c */ +#line 101 "convert.y" + { + Add_NotGridDepend_Var_1((yyvsp[(3) - (4)].na)); + } + break; + + case 11: +/* Line 1807 of yacc.c */ +#line 105 "convert.y" + { + if (!strcasecmp((yyvsp[(2) - (3)].na),"FIXED_GRIDS")) fixedgrids = 1; + if (!strcasecmp((yyvsp[(2) - (3)].na),"ONLY_FIXED_GRIDS")) onlyfixedgrids = 1; + } + break; + + +/* Line 1807 of yacc.c */ +#line 1438 "convert.tab.c" + default: break; + } + /* User semantic actions sometimes alter yychar, and that requires + that yytoken be updated with the new translation. We take the + approach of translating immediately before every use of yytoken. + One alternative is translating here after every semantic action, + but that translation would be missed if the semantic action invokes + YYABORT, YYACCEPT, or YYERROR immediately after altering yychar or + if it invokes YYBACKUP. In the case of YYABORT or YYACCEPT, an + incorrect destructor might then be invoked immediately. In the + case of YYERROR or YYBACKUP, subsequent parser actions might lead + to an incorrect destructor call or verbose syntax error message + before the lookahead is translated. */ + YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc); + + YYPOPSTACK (yylen); + yylen = 0; + YY_STACK_PRINT (yyss, yyssp); + + *++yyvsp = yyval; + + /* Now `shift' the result of the reduction. Determine what state + that goes to, based on the state we popped back to and the rule + number reduced by. */ + + yyn = yyr1[yyn]; + + yystate = yypgoto[yyn - YYNTOKENS] + *yyssp; + if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp) + yystate = yytable[yystate]; + else + yystate = yydefgoto[yyn - YYNTOKENS]; + + goto yynewstate; + + +/*------------------------------------. +| yyerrlab -- here on detecting error | +`------------------------------------*/ +yyerrlab: + /* Make sure we have latest lookahead translation. See comments at + user semantic actions for why this is necessary. */ + yytoken = yychar == YYEMPTY ? YYEMPTY : YYTRANSLATE (yychar); + + /* If not already recovering from an error, report this error. */ + if (!yyerrstatus) + { + ++yynerrs; +#if ! YYERROR_VERBOSE + yyerror (YY_("syntax error")); +#else +# define YYSYNTAX_ERROR yysyntax_error (&yymsg_alloc, &yymsg, \ + yyssp, yytoken) + { + char const *yymsgp = YY_("syntax error"); + int yysyntax_error_status; + yysyntax_error_status = YYSYNTAX_ERROR; + if (yysyntax_error_status == 0) + yymsgp = yymsg; + else if (yysyntax_error_status == 1) + { + if (yymsg != yymsgbuf) + YYSTACK_FREE (yymsg); + yymsg = (char *) YYSTACK_ALLOC (yymsg_alloc); + if (!yymsg) + { + yymsg = yymsgbuf; + yymsg_alloc = sizeof yymsgbuf; + yysyntax_error_status = 2; + } + else + { + yysyntax_error_status = YYSYNTAX_ERROR; + yymsgp = yymsg; + } + } + yyerror (yymsgp); + if (yysyntax_error_status == 2) + goto yyexhaustedlab; + } +# undef YYSYNTAX_ERROR +#endif + } + + + + if (yyerrstatus == 3) + { + /* If just tried and failed to reuse lookahead token after an + error, discard it. */ + + if (yychar <= YYEOF) + { + /* Return failure if at end of input. */ + if (yychar == YYEOF) + YYABORT; + } + else + { + yydestruct ("Error: discarding", + yytoken, &yylval); + yychar = YYEMPTY; + } + } + + /* Else will try to reuse lookahead token after shifting the error + token. */ + goto yyerrlab1; + + +/*---------------------------------------------------. +| yyerrorlab -- error raised explicitly by YYERROR. | +`---------------------------------------------------*/ +yyerrorlab: + + /* Pacify compilers like GCC when the user code never invokes + YYERROR and the label yyerrorlab therefore never appears in user + code. */ + if (/*CONSTCOND*/ 0) + goto yyerrorlab; + + /* Do not reclaim the symbols of the rule which action triggered + this YYERROR. */ + YYPOPSTACK (yylen); + yylen = 0; + YY_STACK_PRINT (yyss, yyssp); + yystate = *yyssp; + goto yyerrlab1; + + +/*-------------------------------------------------------------. +| yyerrlab1 -- common code for both syntax error and YYERROR. | +`-------------------------------------------------------------*/ +yyerrlab1: + yyerrstatus = 3; /* Each real token shifted decrements this. */ + + for (;;) + { + yyn = yypact[yystate]; + if (!yypact_value_is_default (yyn)) + { + yyn += YYTERROR; + if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) + { + yyn = yytable[yyn]; + if (0 < yyn) + break; + } + } + + /* Pop the current state because it cannot handle the error token. */ + if (yyssp == yyss) + YYABORT; + + + yydestruct ("Error: popping", + yystos[yystate], yyvsp); + YYPOPSTACK (1); + yystate = *yyssp; + YY_STACK_PRINT (yyss, yyssp); + } + + YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN + *++yyvsp = yylval; + YY_IGNORE_MAYBE_UNINITIALIZED_END + + + /* Shift the error token. */ + YY_SYMBOL_PRINT ("Shifting", yystos[yyn], yyvsp, yylsp); + + yystate = yyn; + goto yynewstate; + + +/*-------------------------------------. +| yyacceptlab -- YYACCEPT comes here. | +`-------------------------------------*/ +yyacceptlab: + yyresult = 0; + goto yyreturn; + +/*-----------------------------------. +| yyabortlab -- YYABORT comes here. | +`-----------------------------------*/ +yyabortlab: + yyresult = 1; + goto yyreturn; + +#if !defined yyoverflow || YYERROR_VERBOSE +/*-------------------------------------------------. +| yyexhaustedlab -- memory exhaustion comes here. | +`-------------------------------------------------*/ +yyexhaustedlab: + yyerror (YY_("memory exhausted")); + yyresult = 2; + /* Fall through. */ +#endif + +yyreturn: + if (yychar != YYEMPTY) + { + /* Make sure we have latest lookahead translation. See comments at + user semantic actions for why this is necessary. */ + yytoken = YYTRANSLATE (yychar); + yydestruct ("Cleanup: discarding lookahead", + yytoken, &yylval); + } + /* Do not reclaim the symbols of the rule which action triggered + this YYABORT or YYACCEPT. */ + YYPOPSTACK (yylen); + YY_STACK_PRINT (yyss, yyssp); + while (yyssp != yyss) + { + yydestruct ("Cleanup: popping", + yystos[*yyssp], yyvsp); + YYPOPSTACK (1); + } +#ifndef yyoverflow + if (yyss != yyssa) + YYSTACK_FREE (yyss); +#endif +#if YYERROR_VERBOSE + if (yymsg != yymsgbuf) + YYSTACK_FREE (yymsg); +#endif + /* Make sure YYID is used. */ + return YYID (yyresult); +} + + +/* Line 2055 of yacc.c */ +#line 110 "convert.y" + + +void print_usage() +{ + printf("usage : conv -convfile \n"); + printf(" [-workdir ] [-incdir ]\n"); + printf(" [-comdirin ] [-comdirout ]\n"); + printf(" [-convfile ] [-SubloopScalar] [-SubloopScalar1] \n"); + printf(" [-free|-fixed]\n"); + exit(0); +} + +int main(int argc,char *argv[]) +{ + extern FILE * convert_in ; + FILE *dependglobaloutput; + int i; + listnom *parcours; + listvar *newvar; + int stylegiven = 0; + int infreegiven ; + int infixedgiven ; + + char filetoparse[LONG_FNAME]; + +/******************************************************************************/ +/* 1- Variables initialization */ +/******************************************************************************/ + List_Global_Var = (listvar *) NULL; + List_GlobalParameter_Var = (listvar *) NULL; + List_Common_Var = (listvar *) NULL; + List_Allocate_Var = (listallocate *) NULL; + List_SubroutineWhereAgrifUsed = (listnom *) NULL; + List_Subroutine_For_Alloc = (listnom *) NULL; + List_Include = (listusemodule *) NULL; + List_NameOfModuleUsed = (listusemodule *) NULL; + listofmoduletmp = (listusemodule *) NULL; + List_SubroutineDeclaration_Var = (listvar *) NULL; + List_UsedInSubroutine_Var = (listvar *) NULL; + List_NotGridDepend_Var = (listvar *) NULL; + Listofavailableindices = (listindice *) NULL; + Listofavailableindices_glob = (listindice **) calloc(NB_CAT_VARIABLES,sizeof(listindice *)); + List_CouplePointed_Var = (listvarpointtovar *) NULL; + List_ModuleUsed_Var = (listvar *) NULL; + List_ModuleUsedInModuleUsed_Var = (listvar *) NULL; + List_GlobParamModuleUsed_Var = (listparameter *) NULL; + List_GlobParamModuleUsedInModuleUsed_Var = (listparameter *) NULL; + List_SubroutineArgument_Var = (listvar *) NULL; + List_FunctionType_Var = (listvar *) NULL; + tmpuselocallist = (listusemodule *) NULL; + List_ContainsSubroutine = (listnom *) NULL; + List_Do_labels = (listname *) NULL; + oldfortran_out = (FILE *) NULL; + + if ( argc < 2 ) + print_usage(); + + strcpy(config_file, argv[1]); + strcpy(work_dir, "."); + strcpy(input_dir, "."); + strcpy(output_dir, "AGRIF_MODELFILES"); + strcpy(include_dir, "AGRIF_INC"); + strcpy(filetoparse, ""); + strcpy(subofagrifinitgrids, ""); + strcpy(meetagrifinitgrids, ""); + strcpy(mpiinitvar, ""); + + length_last = 0 ; + length_first = 0 ; + length_v_vallengspec = 0 ; + length_v_commoninfile = 0 ; + length_v_precision = 0 ; + length_v_IntentSpec = 0 ; + length_v_initialvalue = 0 ; + length_v_readedlistdimension = 0 ; + length_a_nomvar = 0 ; + length_toprintglob = 0 ; + length_tmpvargridname = 0 ; + length_ligne_Subloop = 0 ; + length_toprint_utilagrif = 0 ; + length_toprinttmp_utilchar = 0 ; + length_ligne_writedecl = 0 ; + length_newname_toamr = 0 ; + length_newname_writedecl = 0 ; + length_ligne_toamr = 0 ; + length_tmpligne_writedecl = 0 ; + value_char_size = 0 ; + value_char_size1 = 0 ; + value_char_size2 = 0 ; + value_char_size3 = 0 ; + inallocate = 0; + infixed = 1; + infree = 0; + + onlyfixedgrids=0; + fixedgrids=0; + InAgrifParentDef = 0; + IndicenbmaillesX=0; + IndicenbmaillesY=0; + IndicenbmaillesZ=0; + created_dimensionlist = 1; + /* current indice in the table tabvars */ + for ( i=0 ; i.in */ +/******************************************************************************/ + + if ( strstr(filetoparse, ".f90") || strstr(filetoparse, ".F90") ) retour77 = 0; + + convert_parse(); + +/******************************************************************************/ +/* 4- Preparation of the file parsing */ +/******************************************************************************/ + + sprintf(dependfilename, "%s/.dependglobal_agrif", work_dir); + /* */ + if ( (dependglobaloutput=fopen(dependfilename, "r")) != NULL ) + { + for (i=0;ivar->v_nomvar, + newvar->var->v_nbdim, + newvar->var->v_subroutinename, + newvar->var->v_modulename, + newvar->var->v_typevar); + newvar = newvar->suiv; + } + +/******************************************************************************/ +/* 6- Write informations in output files */ +/******************************************************************************/ + + /* Write the .dependglobal_agrif file which contain the max indice */ + /* of the tabvars table */ + sprintf(dependfilename, "%s/.dependglobal_agrif", work_dir); + dependglobaloutput = fopen(dependfilename, "w"); + for (i=0;i file which contain general informations */ + /* about variable of this file */ + parcours = List_NameOfModule; + while( parcours ) + { + Writethedependlistofmoduleused(parcours->o_nom); + WritedependParameterList(parcours->o_nom); + Writethedependfile(parcours->o_nom,List_Global_Var); + parcours=parcours->suiv; + } + parcours = List_NameOfCommon; + while( parcours ) + { + Writethedependfile(parcours->o_nom,List_Common_Var); + parcours=parcours->suiv; + } + Write_Subroutine_For_Alloc(); + +/******************************************************************************/ +/* 7- Create files in AGRIF_INC directory */ +/******************************************************************************/ + + creefichieramr(); + + Write_val_max(); + + if ( todebug == 1 ) printf("Out of CONV \n"); + return 0; +} +#line 2 "convert.yy.c" + +#line 4 "convert.yy.c" + +#define YY_INT_ALIGNED short int + +/* A lexical scanner generated by flex */ + +#define yy_create_buffer convert__create_buffer +#define yy_delete_buffer convert__delete_buffer +#define yy_flex_debug convert__flex_debug +#define yy_init_buffer convert__init_buffer +#define yy_flush_buffer convert__flush_buffer +#define yy_load_buffer_state convert__load_buffer_state +#define yy_switch_to_buffer convert__switch_to_buffer +#define yyin convert_in +#define yyleng convert_leng +#define yylex convert_lex +#define yylineno convert_lineno +#define yyout convert_out +#define yyrestart convert_restart +#define yytext convert_text +#define yywrap convert_wrap +#define yyalloc convert_alloc +#define yyrealloc convert_realloc +#define yyfree convert_free + +#define FLEX_SCANNER +#define YY_FLEX_MAJOR_VERSION 2 +#define YY_FLEX_MINOR_VERSION 5 +#define YY_FLEX_SUBMINOR_VERSION 35 +#if YY_FLEX_SUBMINOR_VERSION > 0 +#define FLEX_BETA +#endif + +/* First, we deal with platform-specific or compiler-specific issues. */ + +/* begin standard C headers. */ +#include +#include +#include +#include + +/* end standard C headers. */ + +/* flex integer type definitions */ + +#ifndef FLEXINT_H +#define FLEXINT_H + +/* C99 systems have . Non-C99 systems may or may not. */ + +#if defined (__STDC_VERSION__) && __STDC_VERSION__ >= 199901L + +/* C99 says to define __STDC_LIMIT_MACROS before including stdint.h, + * if you want the limit (max/min) macros for int types. + */ +#ifndef __STDC_LIMIT_MACROS +#define __STDC_LIMIT_MACROS 1 +#endif + +#include +typedef int8_t flex_int8_t; +typedef uint8_t flex_uint8_t; +typedef int16_t flex_int16_t; +typedef uint16_t flex_uint16_t; +typedef int32_t flex_int32_t; +typedef uint32_t flex_uint32_t; +typedef uint64_t flex_uint64_t; +#else +typedef signed char flex_int8_t; +typedef short int flex_int16_t; +typedef int flex_int32_t; +typedef unsigned char flex_uint8_t; +typedef unsigned short int flex_uint16_t; +typedef unsigned int flex_uint32_t; +#endif /* ! C99 */ + +/* Limits of integral types. */ +#ifndef INT8_MIN +#define INT8_MIN (-128) +#endif +#ifndef INT16_MIN +#define INT16_MIN (-32767-1) +#endif +#ifndef INT32_MIN +#define INT32_MIN (-2147483647-1) +#endif +#ifndef INT8_MAX +#define INT8_MAX (127) +#endif +#ifndef INT16_MAX +#define INT16_MAX (32767) +#endif +#ifndef INT32_MAX +#define INT32_MAX (2147483647) +#endif +#ifndef UINT8_MAX +#define UINT8_MAX (255U) +#endif +#ifndef UINT16_MAX +#define UINT16_MAX (65535U) +#endif +#ifndef UINT32_MAX +#define UINT32_MAX (4294967295U) +#endif + +#endif /* ! FLEXINT_H */ + +#ifdef __cplusplus + +/* The "const" storage-class-modifier is valid. */ +#define YY_USE_CONST + +#else /* ! __cplusplus */ + +/* C99 requires __STDC__ to be defined as 1. */ +#if defined (__STDC__) + +#define YY_USE_CONST + +#endif /* defined (__STDC__) */ +#endif /* ! __cplusplus */ + +#ifdef YY_USE_CONST +#define yyconst const +#else +#define yyconst +#endif + +/* Returned upon end-of-file. */ +#define YY_NULL 0 + +/* Promotes a possibly negative, possibly signed char to an unsigned + * integer for use as an array index. If the signed char is negative, + * we want to instead treat it as an 8-bit unsigned char, hence the + * double cast. + */ +#define YY_SC_TO_UI(c) ((unsigned int) (unsigned char) c) + +/* Enter a start condition. This macro really ought to take a parameter, + * but we do it the disgusting crufty way forced on us by the ()-less + * definition of BEGIN. + */ +#define BEGIN (yy_start) = 1 + 2 * + +/* Translate the current start state into a value that can be later handed + * to BEGIN to return to the state. The YYSTATE alias is for lex + * compatibility. + */ +#define YY_START (((yy_start) - 1) / 2) +#define YYSTATE YY_START + +/* Action number for EOF rule of a given start state. */ +#define YY_STATE_EOF(state) (YY_END_OF_BUFFER + state + 1) + +/* Special action meaning "start processing a new file". */ +#define YY_NEW_FILE convert_restart(convert_in ) + +#define YY_END_OF_BUFFER_CHAR 0 + +/* Size of default input buffer. */ +#ifndef YY_BUF_SIZE +#define YY_BUF_SIZE 16384 +#endif + +/* The state buf must be large enough to hold one state per character in the main buffer. + */ +#define YY_STATE_BUF_SIZE ((YY_BUF_SIZE + 2) * sizeof(yy_state_type)) + +#ifndef YY_TYPEDEF_YY_BUFFER_STATE +#define YY_TYPEDEF_YY_BUFFER_STATE +typedef struct yy_buffer_state *YY_BUFFER_STATE; +#endif + +#ifndef YY_TYPEDEF_YY_SIZE_T +#define YY_TYPEDEF_YY_SIZE_T +typedef size_t yy_size_t; +#endif + +extern yy_size_t convert_leng; + +extern FILE *convert_in, *convert_out; + +#define EOB_ACT_CONTINUE_SCAN 0 +#define EOB_ACT_END_OF_FILE 1 +#define EOB_ACT_LAST_MATCH 2 + + #define YY_LESS_LINENO(n) + +/* Return all but the first "n" matched characters back to the input stream. */ +#define yyless(n) \ + do \ + { \ + /* Undo effects of setting up convert_text. */ \ + int yyless_macro_arg = (n); \ + YY_LESS_LINENO(yyless_macro_arg);\ + *yy_cp = (yy_hold_char); \ + YY_RESTORE_YY_MORE_OFFSET \ + (yy_c_buf_p) = yy_cp = yy_bp + yyless_macro_arg - YY_MORE_ADJ; \ + YY_DO_BEFORE_ACTION; /* set up convert_text again */ \ + } \ + while ( 0 ) + +#define unput(c) yyunput( c, (yytext_ptr) ) + +#ifndef YY_STRUCT_YY_BUFFER_STATE +#define YY_STRUCT_YY_BUFFER_STATE +struct yy_buffer_state + { + FILE *yy_input_file; + + char *yy_ch_buf; /* input buffer */ + char *yy_buf_pos; /* current position in input buffer */ + + /* Size of input buffer in bytes, not including room for EOB + * characters. + */ + yy_size_t yy_buf_size; + + /* Number of characters read into yy_ch_buf, not including EOB + * characters. + */ + yy_size_t yy_n_chars; + + /* Whether we "own" the buffer - i.e., we know we created it, + * and can realloc() it to grow it, and should free() it to + * delete it. + */ + int yy_is_our_buffer; + + /* Whether this is an "interactive" input source; if so, and + * if we're using stdio for input, then we want to use getc() + * instead of fread(), to make sure we stop fetching input after + * each newline. + */ + int yy_is_interactive; + + /* Whether we're considered to be at the beginning of a line. + * If so, '^' rules will be active on the next match, otherwise + * not. + */ + int yy_at_bol; + + int yy_bs_lineno; /**< The line count. */ + int yy_bs_column; /**< The column count. */ + + /* Whether to try to fill the input buffer when we reach the + * end of it. + */ + int yy_fill_buffer; + + int yy_buffer_status; + +#define YY_BUFFER_NEW 0 +#define YY_BUFFER_NORMAL 1 + /* When an EOF's been seen but there's still some text to process + * then we mark the buffer as YY_EOF_PENDING, to indicate that we + * shouldn't try reading from the input source any more. We might + * still have a bunch of tokens to match, though, because of + * possible backing-up. + * + * When we actually see the EOF, we change the status to "new" + * (via convert_restart()), so that the user can continue scanning by + * just pointing convert_in at a new input file. + */ +#define YY_BUFFER_EOF_PENDING 2 + + }; +#endif /* !YY_STRUCT_YY_BUFFER_STATE */ + +/* Stack of input buffers. */ +static size_t yy_buffer_stack_top = 0; /**< index of top of stack. */ +static size_t yy_buffer_stack_max = 0; /**< capacity of stack. */ +static YY_BUFFER_STATE * yy_buffer_stack = 0; /**< Stack as an array. */ + +/* We provide macros for accessing buffer states in case in the + * future we want to put the buffer states in a more general + * "scanner state". + * + * Returns the top of the stack, or NULL. + */ +#define YY_CURRENT_BUFFER ( (yy_buffer_stack) \ + ? (yy_buffer_stack)[(yy_buffer_stack_top)] \ + : NULL) + +/* Same as previous macro, but useful when we know that the buffer stack is not + * NULL or when we need an lvalue. For internal use only. + */ +#define YY_CURRENT_BUFFER_LVALUE (yy_buffer_stack)[(yy_buffer_stack_top)] + +/* yy_hold_char holds the character lost when convert_text is formed. */ +static char yy_hold_char; +static yy_size_t yy_n_chars; /* number of characters read into yy_ch_buf */ +yy_size_t convert_leng; + +/* Points to current character in buffer. */ +static char *yy_c_buf_p = (char *) 0; +static int yy_init = 0; /* whether we need to initialize */ +static int yy_start = 0; /* start state number */ + +/* Flag which is used to allow convert_wrap()'s to do buffer switches + * instead of setting up a fresh convert_in. A bit of a hack ... + */ +static int yy_did_buffer_switch_on_eof; + +void convert_restart (FILE *input_file ); +void convert__switch_to_buffer (YY_BUFFER_STATE new_buffer ); +YY_BUFFER_STATE convert__create_buffer (FILE *file,int size ); +void convert__delete_buffer (YY_BUFFER_STATE b ); +void convert__flush_buffer (YY_BUFFER_STATE b ); +void convert_push_buffer_state (YY_BUFFER_STATE new_buffer ); +void convert_pop_buffer_state (void ); + +static void convert_ensure_buffer_stack (void ); +static void convert__load_buffer_state (void ); +static void convert__init_buffer (YY_BUFFER_STATE b,FILE *file ); + +#define YY_FLUSH_BUFFER convert__flush_buffer(YY_CURRENT_BUFFER ) + +YY_BUFFER_STATE convert__scan_buffer (char *base,yy_size_t size ); +YY_BUFFER_STATE convert__scan_string (yyconst char *yy_str ); +YY_BUFFER_STATE convert__scan_bytes (yyconst char *bytes,yy_size_t len ); + +void *convert_alloc (yy_size_t ); +void *convert_realloc (void *,yy_size_t ); +void convert_free (void * ); + +#define yy_new_buffer convert__create_buffer + +#define yy_set_interactive(is_interactive) \ + { \ + if ( ! YY_CURRENT_BUFFER ){ \ + convert_ensure_buffer_stack (); \ + YY_CURRENT_BUFFER_LVALUE = \ + convert__create_buffer(convert_in,YY_BUF_SIZE ); \ + } \ + YY_CURRENT_BUFFER_LVALUE->yy_is_interactive = is_interactive; \ + } + +#define yy_set_bol(at_bol) \ + { \ + if ( ! YY_CURRENT_BUFFER ){\ + convert_ensure_buffer_stack (); \ + YY_CURRENT_BUFFER_LVALUE = \ + convert__create_buffer(convert_in,YY_BUF_SIZE ); \ + } \ + YY_CURRENT_BUFFER_LVALUE->yy_at_bol = at_bol; \ + } + +#define YY_AT_BOL() (YY_CURRENT_BUFFER_LVALUE->yy_at_bol) + +/* Begin user sect3 */ + +#define convert_wrap(n) 1 +#define YY_SKIP_YYWRAP + +typedef unsigned char YY_CHAR; + +FILE *convert_in = (FILE *) 0, *convert_out = (FILE *) 0; + +typedef int yy_state_type; + +extern int convert_lineno; + +int convert_lineno = 1; + +extern char *convert_text; +#define yytext_ptr convert_text + +static yy_state_type yy_get_previous_state (void ); +static yy_state_type yy_try_NUL_trans (yy_state_type current_state ); +static int yy_get_next_buffer (void ); +static void yy_fatal_error (yyconst char msg[] ); + +/* Done after the current pattern has been matched and before the + * corresponding action - sets up convert_text. + */ +#define YY_DO_BEFORE_ACTION \ + (yytext_ptr) = yy_bp; \ + convert_leng = (yy_size_t) (yy_cp - yy_bp); \ + (yy_hold_char) = *yy_cp; \ + *yy_cp = '\0'; \ + (yy_c_buf_p) = yy_cp; + +#define YY_NUM_RULES 15 +#define YY_END_OF_BUFFER 16 +/* This struct is not used in this scanner, + but its presence is necessary. */ +struct yy_trans_info + { + flex_int32_t yy_verify; + flex_int32_t yy_nxt; + }; +static yyconst flex_int16_t yy_accept[84] = + { 0, + 0, 0, 0, 0, 16, 15, 14, 13, 15, 12, + 11, 11, 11, 11, 12, 7, 10, 10, 10, 10, + 10, 10, 10, 14, 0, 4, 11, 9, 9, 9, + 5, 10, 10, 10, 10, 10, 10, 10, 10, 8, + 10, 10, 10, 10, 10, 3, 10, 6, 10, 10, + 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, + 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, + 10, 10, 2, 10, 10, 10, 1, 10, 10, 10, + 10, 8, 0 + } ; + +static yyconst flex_int32_t yy_ec[256] = + { 0, + 1, 1, 1, 1, 1, 1, 1, 1, 2, 3, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 2, 1, 1, 1, 1, 4, 1, 1, 5, + 6, 1, 1, 7, 1, 1, 1, 8, 9, 10, + 11, 8, 8, 8, 12, 8, 8, 13, 14, 1, + 15, 1, 1, 1, 16, 17, 17, 18, 19, 20, + 21, 17, 22, 17, 23, 24, 25, 26, 27, 28, + 17, 29, 30, 31, 32, 17, 17, 33, 34, 17, + 35, 1, 36, 1, 37, 1, 38, 17, 17, 39, + + 40, 41, 42, 17, 43, 17, 44, 45, 46, 47, + 48, 49, 17, 50, 51, 52, 53, 17, 17, 54, + 55, 17, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1 + } ; + +static yyconst flex_int32_t yy_meta[56] = + { 0, + 1, 1, 2, 1, 1, 1, 1, 3, 3, 3, + 3, 3, 1, 1, 1, 3, 3, 3, 3, 3, + 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, + 3, 3, 3, 3, 1, 1, 3, 3, 3, 3, + 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, + 3, 3, 3, 3, 3 + } ; + +static yyconst flex_int16_t yy_base[86] = + { 0, + 0, 0, 0, 0, 192, 194, 186, 194, 176, 194, + 48, 53, 58, 69, 164, 194, 0, 60, 51, 47, + 49, 67, 55, 173, 170, 169, 90, 194, 194, 194, + 194, 0, 160, 53, 62, 58, 66, 62, 74, 0, + 85, 95, 94, 82, 101, 0, 101, 0, 91, 134, + 96, 133, 100, 103, 99, 105, 109, 106, 102, 101, + 113, 99, 115, 113, 119, 127, 123, 139, 130, 142, + 137, 132, 0, 81, 144, 143, 0, 136, 144, 150, + 139, 0, 194, 190, 81 + } ; + +static yyconst flex_int16_t yy_def[86] = + { 0, + 83, 1, 1, 1, 83, 83, 83, 83, 84, 83, + 83, 83, 83, 83, 83, 83, 85, 85, 85, 85, + 85, 85, 85, 83, 84, 84, 83, 83, 83, 83, + 83, 85, 85, 85, 85, 85, 85, 85, 85, 85, + 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, + 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, + 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, + 85, 85, 85, 85, 85, 85, 85, 85, 85, 85, + 85, 85, 0, 83, 83 + } ; + +static yyconst flex_int16_t yy_nxt[250] = + { 0, + 6, 7, 8, 9, 10, 10, 10, 11, 12, 13, + 14, 11, 15, 10, 16, 17, 17, 17, 17, 18, + 17, 17, 19, 17, 17, 20, 21, 22, 17, 17, + 17, 23, 17, 17, 10, 10, 17, 17, 17, 17, + 18, 17, 17, 19, 17, 17, 20, 21, 22, 17, + 17, 17, 23, 17, 17, 27, 27, 27, 27, 27, + 27, 27, 27, 27, 27, 27, 27, 27, 27, 27, + 28, 33, 35, 36, 37, 29, 27, 27, 27, 27, + 27, 34, 38, 32, 39, 41, 30, 42, 43, 44, + 45, 28, 46, 35, 36, 37, 29, 27, 27, 27, + + 27, 27, 34, 47, 38, 39, 41, 30, 42, 43, + 44, 45, 48, 46, 49, 50, 51, 76, 52, 53, + 55, 57, 58, 59, 47, 60, 61, 62, 63, 64, + 65, 66, 67, 48, 68, 49, 50, 69, 51, 52, + 53, 55, 57, 58, 59, 70, 60, 61, 62, 63, + 64, 65, 66, 67, 71, 68, 72, 73, 69, 74, + 75, 40, 77, 78, 79, 80, 70, 81, 82, 56, + 54, 40, 26, 26, 24, 71, 31, 72, 73, 26, + 74, 75, 40, 77, 78, 79, 80, 24, 81, 82, + 25, 83, 25, 5, 83, 83, 83, 83, 83, 83, + + 83, 83, 83, 83, 83, 83, 83, 83, 83, 83, + 83, 83, 83, 83, 83, 83, 83, 83, 83, 83, + 83, 83, 83, 83, 83, 83, 83, 83, 83, 83, + 83, 83, 83, 83, 83, 83, 83, 83, 83, 83, + 83, 83, 83, 83, 83, 83, 83, 83, 83 + } ; + +static yyconst flex_int16_t yy_chk[250] = + { 0, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 11, 11, 11, 11, 11, + 12, 12, 12, 12, 12, 13, 13, 13, 13, 13, + 12, 18, 19, 20, 21, 13, 14, 14, 14, 14, + 14, 18, 22, 85, 23, 34, 14, 35, 36, 37, + 38, 12, 39, 19, 20, 21, 13, 27, 27, 27, + + 27, 27, 18, 41, 22, 23, 34, 14, 35, 36, + 37, 38, 42, 39, 43, 44, 45, 74, 47, 49, + 51, 53, 54, 55, 41, 56, 57, 58, 59, 60, + 61, 62, 63, 42, 64, 43, 44, 65, 45, 47, + 49, 51, 53, 54, 55, 66, 56, 57, 58, 59, + 60, 61, 62, 63, 67, 64, 68, 69, 65, 70, + 71, 72, 75, 76, 78, 79, 66, 80, 81, 52, + 50, 33, 26, 25, 24, 67, 15, 68, 69, 9, + 70, 71, 72, 75, 76, 78, 79, 7, 80, 81, + 84, 5, 84, 83, 83, 83, 83, 83, 83, 83, + + 83, 83, 83, 83, 83, 83, 83, 83, 83, 83, + 83, 83, 83, 83, 83, 83, 83, 83, 83, 83, + 83, 83, 83, 83, 83, 83, 83, 83, 83, 83, + 83, 83, 83, 83, 83, 83, 83, 83, 83, 83, + 83, 83, 83, 83, 83, 83, 83, 83, 83 + } ; + +static yy_state_type yy_last_accepting_state; +static char *yy_last_accepting_cpos; + +extern int convert__flex_debug; +int convert__flex_debug = 0; + +/* The intent behind this definition is that it'll catch + * any uses of REJECT which flex missed. + */ +#define REJECT reject_used_but_not_detected +#define yymore() yymore_used_but_not_detected +#define YY_MORE_ADJ 0 +#define YY_RESTORE_YY_MORE_OFFSET +char *convert_text; +#line 1 "convert.lex" +/******************************************************************************/ +/* */ +/* CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran) */ +/* */ +/* Copyright or or Copr. Laurent Debreu (Laurent.Debreu@imag.fr) */ +/* Cyril Mazauric (Cyril_Mazauric@yahoo.fr) */ +/* This software is governed by the CeCILL-C license under French law and */ +/* abiding by the rules of distribution of free software. You can use, */ +/* modify and/ or redistribute the software under the terms of the CeCILL-C */ +/* license as circulated by CEA, CNRS and INRIA at the following URL */ +/* "http://www.cecill.info". */ +/* */ +/* As a counterpart to the access to the source code and rights to copy, */ +/* modify and redistribute granted by the license, users are provided only */ +/* with a limited warranty and the software's author, the holder of the */ +/* economic rights, and the successive licensors have only limited */ +/* liability. */ +/* */ +/* In this respect, the user's attention is drawn to the risks associated */ +/* with loading, using, modifying and/or developing or reproducing the */ +/* software by the user in light of its specific status of free software, */ +/* that may mean that it is complicated to manipulate, and that also */ +/* therefore means that it is reserved for developers and experienced */ +/* professionals having in-depth computer knowledge. Users are therefore */ +/* encouraged to load and test the software's suitability as regards their */ +/* requirements in conditions enabling the security of their systems and/or */ +/* data to be ensured and, more generally, to use and operate it in the */ +/* same conditions as regards security. */ +/* */ +/* The fact that you are presently reading this means that you have had */ +/* knowledge of the CeCILL-C license and that you accept its terms. */ +/******************************************************************************/ +/* version 1.7 */ +/******************************************************************************/ + +#line 40 "convert.lex" +#include +#include +#include + +#define YY_NO_INPUT +#line 595 "convert.yy.c" + +#define INITIAL 0 +#define character 1 + +#ifndef YY_NO_UNISTD_H +/* Special case for "unistd.h", since it is non-ANSI. We include it way + * down here because we want the user's section 1 to have been scanned first. + * The user has a chance to override it with an option. + */ +#include +#endif + +#ifndef YY_EXTRA_TYPE +#define YY_EXTRA_TYPE void * +#endif + +static int yy_init_globals (void ); + +/* Accessor methods to globals. + These are made visible to non-reentrant scanners for convenience. */ + +int convert_lex_destroy (void ); + +int convert_get_debug (void ); + +void convert_set_debug (int debug_flag ); + +YY_EXTRA_TYPE convert_get_extra (void ); + +void convert_set_extra (YY_EXTRA_TYPE user_defined ); + +FILE *convert_get_in (void ); + +void convert_set_in (FILE * in_str ); + +FILE *convert_get_out (void ); + +void convert_set_out (FILE * out_str ); + +yy_size_t convert_get_leng (void ); + +char *convert_get_text (void ); + +int convert_get_lineno (void ); + +void convert_set_lineno (int line_number ); + +/* Macros after this point can all be overridden by user definitions in + * section 1. + */ + +#ifndef YY_SKIP_YYWRAP +#ifdef __cplusplus +extern "C" int convert_wrap (void ); +#else +extern int convert_wrap (void ); +#endif +#endif + + static void yyunput (int c,char *buf_ptr ); + +#ifndef yytext_ptr +static void yy_flex_strncpy (char *,yyconst char *,int ); +#endif + +#ifdef YY_NEED_STRLEN +static int yy_flex_strlen (yyconst char * ); +#endif + +#ifndef YY_NO_INPUT + +#ifdef __cplusplus +static int yyinput (void ); +#else +static int input (void ); +#endif + +#endif + +/* Amount of stuff to slurp up with each read. */ +#ifndef YY_READ_BUF_SIZE +#define YY_READ_BUF_SIZE 8192 +#endif + +/* Copy whatever the last rule matched to the standard output. */ +#ifndef ECHO +/* This used to be an fputs(), but since the string might contain NUL's, + * we now use fwrite(). + */ +#define ECHO fwrite( convert_text, convert_leng, 1, convert_out ) +#endif + +/* Gets input and stuffs it into "buf". number of characters read, or YY_NULL, + * is returned in "result". + */ +#ifndef YY_INPUT +#define YY_INPUT(buf,result,max_size) \ + if ( YY_CURRENT_BUFFER_LVALUE->yy_is_interactive ) \ + { \ + int c = '*'; \ + yy_size_t n; \ + for ( n = 0; n < max_size && \ + (c = getc( convert_in )) != EOF && c != '\n'; ++n ) \ + buf[n] = (char) c; \ + if ( c == '\n' ) \ + buf[n++] = (char) c; \ + if ( c == EOF && ferror( convert_in ) ) \ + YY_FATAL_ERROR( "input in flex scanner failed" ); \ + result = n; \ + } \ + else \ + { \ + errno=0; \ + while ( (result = fread(buf, 1, max_size, convert_in))==0 && ferror(convert_in)) \ + { \ + if( errno != EINTR) \ + { \ + YY_FATAL_ERROR( "input in flex scanner failed" ); \ + break; \ + } \ + errno=0; \ + clearerr(convert_in); \ + } \ + }\ +\ + +#endif + +/* No semi-colon after return; correct usage is to write "yyterminate();" - + * we don't want an extra ';' after the "return" because that will cause + * some compilers to complain about unreachable statements. + */ +#ifndef yyterminate +#define yyterminate() return YY_NULL +#endif + +/* Number of entries by which start-condition stack grows. */ +#ifndef YY_START_STACK_INCR +#define YY_START_STACK_INCR 25 +#endif + +/* Report a fatal error. */ +#ifndef YY_FATAL_ERROR +#define YY_FATAL_ERROR(msg) yy_fatal_error( msg ) +#endif + +/* end tables serialization structures and prototypes */ + +/* Default declaration of generated scanner - a define so the user can + * easily add parameters. + */ +#ifndef YY_DECL +#define YY_DECL_IS_OURS 1 + +extern int convert_lex (void); + +#define YY_DECL int convert_lex (void) +#endif /* !YY_DECL */ + +/* Code executed at the beginning of each rule, after convert_text and convert_leng + * have been set up. + */ +#ifndef YY_USER_ACTION +#define YY_USER_ACTION +#endif + +/* Code executed at the end of each rule. */ +#ifndef YY_BREAK +#define YY_BREAK break; +#endif + +#define YY_RULE_SETUP \ + YY_USER_ACTION + +/** The main scanner function which does all the work. + */ +YY_DECL +{ + register yy_state_type yy_current_state; + register char *yy_cp, *yy_bp; + register int yy_act; + +#line 54 "convert.lex" + +#line 780 "convert.yy.c" + + if ( !(yy_init) ) + { + (yy_init) = 1; + +#ifdef YY_USER_INIT + YY_USER_INIT; +#endif + + if ( ! (yy_start) ) + (yy_start) = 1; /* first start state */ + + if ( ! convert_in ) + convert_in = stdin; + + if ( ! convert_out ) + convert_out = stdout; + + if ( ! YY_CURRENT_BUFFER ) { + convert_ensure_buffer_stack (); + YY_CURRENT_BUFFER_LVALUE = + convert__create_buffer(convert_in,YY_BUF_SIZE ); + } + + convert__load_buffer_state( ); + } + + while ( 1 ) /* loops until end-of-file is reached */ + { + yy_cp = (yy_c_buf_p); + + /* Support of convert_text. */ + *yy_cp = (yy_hold_char); + + /* yy_bp points to the position in yy_ch_buf of the start of + * the current run. + */ + yy_bp = yy_cp; + + yy_current_state = (yy_start); +yy_match: + do + { + register YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)]; + if ( yy_accept[yy_current_state] ) + { + (yy_last_accepting_state) = yy_current_state; + (yy_last_accepting_cpos) = yy_cp; + } + while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) + { + yy_current_state = (int) yy_def[yy_current_state]; + if ( yy_current_state >= 84 ) + yy_c = yy_meta[(unsigned int) yy_c]; + } + yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c]; + ++yy_cp; + } + while ( yy_base[yy_current_state] != 194 ); + +yy_find_action: + yy_act = yy_accept[yy_current_state]; + if ( yy_act == 0 ) + { /* have to back up */ + yy_cp = (yy_last_accepting_cpos); + yy_current_state = (yy_last_accepting_state); + yy_act = yy_accept[yy_current_state]; + } + + YY_DO_BEFORE_ACTION; + +do_action: /* This label is used only to access EOF actions. */ + + switch ( yy_act ) + { /* beginning of action switch */ + case 0: /* must back up */ + /* undo the effects of YY_DO_BEFORE_ACTION */ + *yy_cp = (yy_hold_char); + yy_cp = (yy_last_accepting_cpos); + yy_current_state = (yy_last_accepting_state); + goto yy_find_action; + +case 1: +YY_RULE_SETUP +#line 55 "convert.lex" +{ return TOK_MODULEMAIN; } /* name of the module */ + YY_BREAK +case 2: +YY_RULE_SETUP +#line 56 "convert.lex" +{ return TOK_NOTGRIDDEP; } /* variable which are not grid dependent */ + YY_BREAK +case 3: +YY_RULE_SETUP +#line 57 "convert.lex" +{ return TOK_USE; } + YY_BREAK +case 4: +YY_RULE_SETUP +#line 58 "convert.lex" +{ } + YY_BREAK +case 5: +YY_RULE_SETUP +#line 59 "convert.lex" +{ return TOK_SEP; } + YY_BREAK +case 6: +YY_RULE_SETUP +#line 60 "convert.lex" +{ return TOK_KIND; } + YY_BREAK +case 7: +YY_RULE_SETUP +#line 61 "convert.lex" +{ return TOK_EQUAL; } + YY_BREAK +case 8: +YY_RULE_SETUP +#line 62 "convert.lex" +{ strcpy(yylval.na,convert_text); return TOK_USEITEM; } + YY_BREAK +case 9: +YY_RULE_SETUP +#line 63 "convert.lex" +{ strcpy(yylval.na,convert_text); return TOK_PROBTYPE; } /* dimension of the problem */ + YY_BREAK +case 10: +YY_RULE_SETUP +#line 64 "convert.lex" +{ strcpy(yylval.na,convert_text); return TOK_NAME; } + YY_BREAK +case 11: +YY_RULE_SETUP +#line 65 "convert.lex" +{ strcpy(yylval.na,convert_text); return TOK_CSTINT; } + YY_BREAK +case 12: +YY_RULE_SETUP +#line 66 "convert.lex" +{ return (int) *convert_text; } + YY_BREAK +case 13: +/* rule 13 can match eol */ +YY_RULE_SETUP +#line 67 "convert.lex" +{ line_num++; return (int) *convert_text; } + YY_BREAK +case 14: +YY_RULE_SETUP +#line 68 "convert.lex" +; + YY_BREAK +case 15: +YY_RULE_SETUP +#line 69 "convert.lex" +ECHO; + YY_BREAK +#line 939 "convert.yy.c" +case YY_STATE_EOF(INITIAL): +case YY_STATE_EOF(character): + yyterminate(); + + case YY_END_OF_BUFFER: + { + /* Amount of text matched not including the EOB char. */ + int yy_amount_of_matched_text = (int) (yy_cp - (yytext_ptr)) - 1; + + /* Undo the effects of YY_DO_BEFORE_ACTION. */ + *yy_cp = (yy_hold_char); + YY_RESTORE_YY_MORE_OFFSET + + if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_NEW ) + { + /* We're scanning a new file or input source. It's + * possible that this happened because the user + * just pointed convert_in at a new source and called + * convert_lex(). If so, then we have to assure + * consistency between YY_CURRENT_BUFFER and our + * globals. Here is the right place to do so, because + * this is the first action (other than possibly a + * back-up) that will match for the new input source. + */ + (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars; + YY_CURRENT_BUFFER_LVALUE->yy_input_file = convert_in; + YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_NORMAL; + } + + /* Note that here we test for yy_c_buf_p "<=" to the position + * of the first EOB in the buffer, since yy_c_buf_p will + * already have been incremented past the NUL character + * (since all states make transitions on EOB to the + * end-of-buffer state). Contrast this with the test + * in input(). + */ + if ( (yy_c_buf_p) <= &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] ) + { /* This was really a NUL. */ + yy_state_type yy_next_state; + + (yy_c_buf_p) = (yytext_ptr) + yy_amount_of_matched_text; + + yy_current_state = yy_get_previous_state( ); + + /* Okay, we're now positioned to make the NUL + * transition. We couldn't have + * yy_get_previous_state() go ahead and do it + * for us because it doesn't know how to deal + * with the possibility of jamming (and we don't + * want to build jamming into it because then it + * will run more slowly). + */ + + yy_next_state = yy_try_NUL_trans( yy_current_state ); + + yy_bp = (yytext_ptr) + YY_MORE_ADJ; + + if ( yy_next_state ) + { + /* Consume the NUL. */ + yy_cp = ++(yy_c_buf_p); + yy_current_state = yy_next_state; + goto yy_match; + } + + else + { + yy_cp = (yy_c_buf_p); + goto yy_find_action; + } + } + + else switch ( yy_get_next_buffer( ) ) + { + case EOB_ACT_END_OF_FILE: + { + (yy_did_buffer_switch_on_eof) = 0; + + if ( convert_wrap( ) ) + { + /* Note: because we've taken care in + * yy_get_next_buffer() to have set up + * convert_text, we can now set up + * yy_c_buf_p so that if some total + * hoser (like flex itself) wants to + * call the scanner after we return the + * YY_NULL, it'll still work - another + * YY_NULL will get returned. + */ + (yy_c_buf_p) = (yytext_ptr) + YY_MORE_ADJ; + + yy_act = YY_STATE_EOF(YY_START); + goto do_action; + } + + else + { + if ( ! (yy_did_buffer_switch_on_eof) ) + YY_NEW_FILE; + } + break; + } + + case EOB_ACT_CONTINUE_SCAN: + (yy_c_buf_p) = + (yytext_ptr) + yy_amount_of_matched_text; + + yy_current_state = yy_get_previous_state( ); + + yy_cp = (yy_c_buf_p); + yy_bp = (yytext_ptr) + YY_MORE_ADJ; + goto yy_match; + + case EOB_ACT_LAST_MATCH: + (yy_c_buf_p) = + &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)]; + + yy_current_state = yy_get_previous_state( ); + + yy_cp = (yy_c_buf_p); + yy_bp = (yytext_ptr) + YY_MORE_ADJ; + goto yy_find_action; + } + break; + } + + default: + YY_FATAL_ERROR( + "fatal flex scanner internal error--no action found" ); + } /* end of action switch */ + } /* end of scanning one token */ +} /* end of convert_lex */ + +/* yy_get_next_buffer - try to read in a new buffer + * + * Returns a code representing an action: + * EOB_ACT_LAST_MATCH - + * EOB_ACT_CONTINUE_SCAN - continue scanning from current position + * EOB_ACT_END_OF_FILE - end of file + */ +static int yy_get_next_buffer (void) +{ + register char *dest = YY_CURRENT_BUFFER_LVALUE->yy_ch_buf; + register char *source = (yytext_ptr); + register int number_to_move, i; + int ret_val; + + if ( (yy_c_buf_p) > &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] ) + YY_FATAL_ERROR( + "fatal flex scanner internal error--end of buffer missed" ); + + if ( YY_CURRENT_BUFFER_LVALUE->yy_fill_buffer == 0 ) + { /* Don't try to fill the buffer, so this is an EOF. */ + if ( (yy_c_buf_p) - (yytext_ptr) - YY_MORE_ADJ == 1 ) + { + /* We matched a single character, the EOB, so + * treat this as a final EOF. + */ + return EOB_ACT_END_OF_FILE; + } + + else + { + /* We matched some text prior to the EOB, first + * process it. + */ + return EOB_ACT_LAST_MATCH; + } + } + + /* Try to read more data. */ + + /* First move last chars to start of buffer. */ + number_to_move = (int) ((yy_c_buf_p) - (yytext_ptr)) - 1; + + for ( i = 0; i < number_to_move; ++i ) + *(dest++) = *(source++); + + if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_EOF_PENDING ) + /* don't do the read, it's not guaranteed to return an EOF, + * just force an EOF + */ + YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars) = 0; + + else + { + yy_size_t num_to_read = + YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1; + + while ( num_to_read <= 0 ) + { /* Not enough room in the buffer - grow it. */ + + /* just a shorter name for the current buffer */ + YY_BUFFER_STATE b = YY_CURRENT_BUFFER; + + int yy_c_buf_p_offset = + (int) ((yy_c_buf_p) - b->yy_ch_buf); + + if ( b->yy_is_our_buffer ) + { + yy_size_t new_size = b->yy_buf_size * 2; + + if ( new_size <= 0 ) + b->yy_buf_size += b->yy_buf_size / 8; + else + b->yy_buf_size *= 2; + + b->yy_ch_buf = (char *) + /* Include room in for 2 EOB chars. */ + convert_realloc((void *) b->yy_ch_buf,b->yy_buf_size + 2 ); + } + else + /* Can't grow it, we don't own it. */ + b->yy_ch_buf = 0; + + if ( ! b->yy_ch_buf ) + YY_FATAL_ERROR( + "fatal error - scanner input buffer overflow" ); + + (yy_c_buf_p) = &b->yy_ch_buf[yy_c_buf_p_offset]; + + num_to_read = YY_CURRENT_BUFFER_LVALUE->yy_buf_size - + number_to_move - 1; + + } + + if ( num_to_read > YY_READ_BUF_SIZE ) + num_to_read = YY_READ_BUF_SIZE; + + /* Read in more data. */ + YY_INPUT( (&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]), + (yy_n_chars), num_to_read ); + + YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars); + } + + if ( (yy_n_chars) == 0 ) + { + if ( number_to_move == YY_MORE_ADJ ) + { + ret_val = EOB_ACT_END_OF_FILE; + convert_restart(convert_in ); + } + + else + { + ret_val = EOB_ACT_LAST_MATCH; + YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = + YY_BUFFER_EOF_PENDING; + } + } + + else + ret_val = EOB_ACT_CONTINUE_SCAN; + + if ((yy_size_t) ((yy_n_chars) + number_to_move) > YY_CURRENT_BUFFER_LVALUE->yy_buf_size) { + /* Extend the array by 50%, plus the number we really need. */ + yy_size_t new_size = (yy_n_chars) + number_to_move + ((yy_n_chars) >> 1); + YY_CURRENT_BUFFER_LVALUE->yy_ch_buf = (char *) convert_realloc((void *) YY_CURRENT_BUFFER_LVALUE->yy_ch_buf,new_size ); + if ( ! YY_CURRENT_BUFFER_LVALUE->yy_ch_buf ) + YY_FATAL_ERROR( "out of dynamic memory in yy_get_next_buffer()" ); + } + + (yy_n_chars) += number_to_move; + YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] = YY_END_OF_BUFFER_CHAR; + YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] = YY_END_OF_BUFFER_CHAR; + + (yytext_ptr) = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[0]; + + return ret_val; +} + +/* yy_get_previous_state - get the state just before the EOB char was reached */ + + static yy_state_type yy_get_previous_state (void) +{ + register yy_state_type yy_current_state; + register char *yy_cp; + + yy_current_state = (yy_start); + + for ( yy_cp = (yytext_ptr) + YY_MORE_ADJ; yy_cp < (yy_c_buf_p); ++yy_cp ) + { + register YY_CHAR yy_c = (*yy_cp ? yy_ec[YY_SC_TO_UI(*yy_cp)] : 1); + if ( yy_accept[yy_current_state] ) + { + (yy_last_accepting_state) = yy_current_state; + (yy_last_accepting_cpos) = yy_cp; + } + while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) + { + yy_current_state = (int) yy_def[yy_current_state]; + if ( yy_current_state >= 84 ) + yy_c = yy_meta[(unsigned int) yy_c]; + } + yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c]; + } + + return yy_current_state; +} + +/* yy_try_NUL_trans - try to make a transition on the NUL character + * + * synopsis + * next_state = yy_try_NUL_trans( current_state ); + */ + static yy_state_type yy_try_NUL_trans (yy_state_type yy_current_state ) +{ + register int yy_is_jam; + register char *yy_cp = (yy_c_buf_p); + + register YY_CHAR yy_c = 1; + if ( yy_accept[yy_current_state] ) + { + (yy_last_accepting_state) = yy_current_state; + (yy_last_accepting_cpos) = yy_cp; + } + while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state ) + { + yy_current_state = (int) yy_def[yy_current_state]; + if ( yy_current_state >= 84 ) + yy_c = yy_meta[(unsigned int) yy_c]; + } + yy_current_state = yy_nxt[yy_base[yy_current_state] + (unsigned int) yy_c]; + yy_is_jam = (yy_current_state == 83); + + return yy_is_jam ? 0 : yy_current_state; +} + + static void yyunput (int c, register char * yy_bp ) +{ + register char *yy_cp; + + yy_cp = (yy_c_buf_p); + + /* undo effects of setting up convert_text */ + *yy_cp = (yy_hold_char); + + if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 ) + { /* need to shift things up to make room */ + /* +2 for EOB chars. */ + register yy_size_t number_to_move = (yy_n_chars) + 2; + register char *dest = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[ + YY_CURRENT_BUFFER_LVALUE->yy_buf_size + 2]; + register char *source = + &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]; + + while ( source > YY_CURRENT_BUFFER_LVALUE->yy_ch_buf ) + *--dest = *--source; + + yy_cp += (int) (dest - source); + yy_bp += (int) (dest - source); + YY_CURRENT_BUFFER_LVALUE->yy_n_chars = + (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_buf_size; + + if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 ) + YY_FATAL_ERROR( "flex scanner push-back overflow" ); + } + + *--yy_cp = (char) c; + + (yytext_ptr) = yy_bp; + (yy_hold_char) = *yy_cp; + (yy_c_buf_p) = yy_cp; +} + +#ifndef YY_NO_INPUT +#ifdef __cplusplus + static int yyinput (void) +#else + static int input (void) +#endif + +{ + int c; + + *(yy_c_buf_p) = (yy_hold_char); + + if ( *(yy_c_buf_p) == YY_END_OF_BUFFER_CHAR ) + { + /* yy_c_buf_p now points to the character we want to return. + * If this occurs *before* the EOB characters, then it's a + * valid NUL; if not, then we've hit the end of the buffer. + */ + if ( (yy_c_buf_p) < &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] ) + /* This was really a NUL. */ + *(yy_c_buf_p) = '\0'; + + else + { /* need more input */ + yy_size_t offset = (yy_c_buf_p) - (yytext_ptr); + ++(yy_c_buf_p); + + switch ( yy_get_next_buffer( ) ) + { + case EOB_ACT_LAST_MATCH: + /* This happens because yy_g_n_b() + * sees that we've accumulated a + * token and flags that we need to + * try matching the token before + * proceeding. But for input(), + * there's no matching to consider. + * So convert the EOB_ACT_LAST_MATCH + * to EOB_ACT_END_OF_FILE. + */ + + /* Reset buffer status. */ + convert_restart(convert_in ); + + /*FALLTHROUGH*/ + + case EOB_ACT_END_OF_FILE: + { + if ( convert_wrap( ) ) + return 0; + + if ( ! (yy_did_buffer_switch_on_eof) ) + YY_NEW_FILE; +#ifdef __cplusplus + return yyinput(); +#else + return input(); +#endif + } + + case EOB_ACT_CONTINUE_SCAN: + (yy_c_buf_p) = (yytext_ptr) + offset; + break; + } + } + } + + c = *(unsigned char *) (yy_c_buf_p); /* cast for 8-bit char's */ + *(yy_c_buf_p) = '\0'; /* preserve convert_text */ + (yy_hold_char) = *++(yy_c_buf_p); + + return c; +} +#endif /* ifndef YY_NO_INPUT */ + +/** Immediately switch to a different input stream. + * @param input_file A readable stream. + * + * @note This function does not reset the start condition to @c INITIAL . + */ + void convert_restart (FILE * input_file ) +{ + + if ( ! YY_CURRENT_BUFFER ){ + convert_ensure_buffer_stack (); + YY_CURRENT_BUFFER_LVALUE = + convert__create_buffer(convert_in,YY_BUF_SIZE ); + } + + convert__init_buffer(YY_CURRENT_BUFFER,input_file ); + convert__load_buffer_state( ); +} + +/** Switch to a different input buffer. + * @param new_buffer The new input buffer. + * + */ + void convert__switch_to_buffer (YY_BUFFER_STATE new_buffer ) +{ + + /* TODO. We should be able to replace this entire function body + * with + * convert_pop_buffer_state(); + * convert_push_buffer_state(new_buffer); + */ + convert_ensure_buffer_stack (); + if ( YY_CURRENT_BUFFER == new_buffer ) + return; + + if ( YY_CURRENT_BUFFER ) + { + /* Flush out information for old buffer. */ + *(yy_c_buf_p) = (yy_hold_char); + YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p); + YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars); + } + + YY_CURRENT_BUFFER_LVALUE = new_buffer; + convert__load_buffer_state( ); + + /* We don't actually know whether we did this switch during + * EOF (convert_wrap()) processing, but the only time this flag + * is looked at is after convert_wrap() is called, so it's safe + * to go ahead and always set it. + */ + (yy_did_buffer_switch_on_eof) = 1; +} + +static void convert__load_buffer_state (void) +{ + (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars; + (yytext_ptr) = (yy_c_buf_p) = YY_CURRENT_BUFFER_LVALUE->yy_buf_pos; + convert_in = YY_CURRENT_BUFFER_LVALUE->yy_input_file; + (yy_hold_char) = *(yy_c_buf_p); +} + +/** Allocate and initialize an input buffer state. + * @param file A readable stream. + * @param size The character buffer size in bytes. When in doubt, use @c YY_BUF_SIZE. + * + * @return the allocated buffer state. + */ + YY_BUFFER_STATE convert__create_buffer (FILE * file, int size ) +{ + YY_BUFFER_STATE b; + + b = (YY_BUFFER_STATE) convert_alloc(sizeof( struct yy_buffer_state ) ); + if ( ! b ) + YY_FATAL_ERROR( "out of dynamic memory in convert__create_buffer()" ); + + b->yy_buf_size = size; + + /* yy_ch_buf has to be 2 characters longer than the size given because + * we need to put in 2 end-of-buffer characters. + */ + b->yy_ch_buf = (char *) convert_alloc(b->yy_buf_size + 2 ); + if ( ! b->yy_ch_buf ) + YY_FATAL_ERROR( "out of dynamic memory in convert__create_buffer()" ); + + b->yy_is_our_buffer = 1; + + convert__init_buffer(b,file ); + + return b; +} + +/** Destroy the buffer. + * @param b a buffer created with convert__create_buffer() + * + */ + void convert__delete_buffer (YY_BUFFER_STATE b ) +{ + + if ( ! b ) + return; + + if ( b == YY_CURRENT_BUFFER ) /* Not sure if we should pop here. */ + YY_CURRENT_BUFFER_LVALUE = (YY_BUFFER_STATE) 0; + + if ( b->yy_is_our_buffer ) + convert_free((void *) b->yy_ch_buf ); + + convert_free((void *) b ); +} + +#ifndef __cplusplus +extern int isatty (int ); +#endif /* __cplusplus */ + +/* Initializes or reinitializes a buffer. + * This function is sometimes called more than once on the same buffer, + * such as during a convert_restart() or at EOF. + */ + static void convert__init_buffer (YY_BUFFER_STATE b, FILE * file ) + +{ + int oerrno = errno; + + convert__flush_buffer(b ); + + b->yy_input_file = file; + b->yy_fill_buffer = 1; + + /* If b is the current buffer, then convert__init_buffer was _probably_ + * called from convert_restart() or through yy_get_next_buffer. + * In that case, we don't want to reset the lineno or column. + */ + if (b != YY_CURRENT_BUFFER){ + b->yy_bs_lineno = 1; + b->yy_bs_column = 0; + } + + b->yy_is_interactive = file ? (isatty( fileno(file) ) > 0) : 0; + + errno = oerrno; +} + +/** Discard all buffered characters. On the next scan, YY_INPUT will be called. + * @param b the buffer state to be flushed, usually @c YY_CURRENT_BUFFER. + * + */ + void convert__flush_buffer (YY_BUFFER_STATE b ) +{ + if ( ! b ) + return; + + b->yy_n_chars = 0; + + /* We always need two end-of-buffer characters. The first causes + * a transition to the end-of-buffer state. The second causes + * a jam in that state. + */ + b->yy_ch_buf[0] = YY_END_OF_BUFFER_CHAR; + b->yy_ch_buf[1] = YY_END_OF_BUFFER_CHAR; + + b->yy_buf_pos = &b->yy_ch_buf[0]; + + b->yy_at_bol = 1; + b->yy_buffer_status = YY_BUFFER_NEW; + + if ( b == YY_CURRENT_BUFFER ) + convert__load_buffer_state( ); +} + +/** Pushes the new state onto the stack. The new state becomes + * the current state. This function will allocate the stack + * if necessary. + * @param new_buffer The new state. + * + */ +void convert_push_buffer_state (YY_BUFFER_STATE new_buffer ) +{ + if (new_buffer == NULL) + return; + + convert_ensure_buffer_stack(); + + /* This block is copied from convert__switch_to_buffer. */ + if ( YY_CURRENT_BUFFER ) + { + /* Flush out information for old buffer. */ + *(yy_c_buf_p) = (yy_hold_char); + YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p); + YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars); + } + + /* Only push if top exists. Otherwise, replace top. */ + if (YY_CURRENT_BUFFER) + (yy_buffer_stack_top)++; + YY_CURRENT_BUFFER_LVALUE = new_buffer; + + /* copied from convert__switch_to_buffer. */ + convert__load_buffer_state( ); + (yy_did_buffer_switch_on_eof) = 1; +} + +/** Removes and deletes the top of the stack, if present. + * The next element becomes the new top. + * + */ +void convert_pop_buffer_state (void) +{ + if (!YY_CURRENT_BUFFER) + return; + + convert__delete_buffer(YY_CURRENT_BUFFER ); + YY_CURRENT_BUFFER_LVALUE = NULL; + if ((yy_buffer_stack_top) > 0) + --(yy_buffer_stack_top); + + if (YY_CURRENT_BUFFER) { + convert__load_buffer_state( ); + (yy_did_buffer_switch_on_eof) = 1; + } +} + +/* Allocates the stack if it does not exist. + * Guarantees space for at least one push. + */ +static void convert_ensure_buffer_stack (void) +{ + yy_size_t num_to_alloc; + + if (!(yy_buffer_stack)) { + + /* First allocation is just for 2 elements, since we don't know if this + * scanner will even need a stack. We use 2 instead of 1 to avoid an + * immediate realloc on the next call. + */ + num_to_alloc = 1; + (yy_buffer_stack) = (struct yy_buffer_state**)convert_alloc + (num_to_alloc * sizeof(struct yy_buffer_state*) + ); + if ( ! (yy_buffer_stack) ) + YY_FATAL_ERROR( "out of dynamic memory in convert_ensure_buffer_stack()" ); + + memset((yy_buffer_stack), 0, num_to_alloc * sizeof(struct yy_buffer_state*)); + + (yy_buffer_stack_max) = num_to_alloc; + (yy_buffer_stack_top) = 0; + return; + } + + if ((yy_buffer_stack_top) >= ((yy_buffer_stack_max)) - 1){ + + /* Increase the buffer to prepare for a possible push. */ + int grow_size = 8 /* arbitrary grow size */; + + num_to_alloc = (yy_buffer_stack_max) + grow_size; + (yy_buffer_stack) = (struct yy_buffer_state**)convert_realloc + ((yy_buffer_stack), + num_to_alloc * sizeof(struct yy_buffer_state*) + ); + if ( ! (yy_buffer_stack) ) + YY_FATAL_ERROR( "out of dynamic memory in convert_ensure_buffer_stack()" ); + + /* zero only the new slots.*/ + memset((yy_buffer_stack) + (yy_buffer_stack_max), 0, grow_size * sizeof(struct yy_buffer_state*)); + (yy_buffer_stack_max) = num_to_alloc; + } +} + +/** Setup the input buffer state to scan directly from a user-specified character buffer. + * @param base the character buffer + * @param size the size in bytes of the character buffer + * + * @return the newly allocated buffer state object. + */ +YY_BUFFER_STATE convert__scan_buffer (char * base, yy_size_t size ) +{ + YY_BUFFER_STATE b; + + if ( size < 2 || + base[size-2] != YY_END_OF_BUFFER_CHAR || + base[size-1] != YY_END_OF_BUFFER_CHAR ) + /* They forgot to leave room for the EOB's. */ + return 0; + + b = (YY_BUFFER_STATE) convert_alloc(sizeof( struct yy_buffer_state ) ); + if ( ! b ) + YY_FATAL_ERROR( "out of dynamic memory in convert__scan_buffer()" ); + + b->yy_buf_size = size - 2; /* "- 2" to take care of EOB's */ + b->yy_buf_pos = b->yy_ch_buf = base; + b->yy_is_our_buffer = 0; + b->yy_input_file = 0; + b->yy_n_chars = b->yy_buf_size; + b->yy_is_interactive = 0; + b->yy_at_bol = 1; + b->yy_fill_buffer = 0; + b->yy_buffer_status = YY_BUFFER_NEW; + + convert__switch_to_buffer(b ); + + return b; +} + +/** Setup the input buffer state to scan a string. The next call to convert_lex() will + * scan from a @e copy of @a str. + * @param yystr a NUL-terminated string to scan + * + * @return the newly allocated buffer state object. + * @note If you want to scan bytes that may contain NUL values, then use + * convert__scan_bytes() instead. + */ +YY_BUFFER_STATE convert__scan_string (yyconst char * yystr ) +{ + + return convert__scan_bytes(yystr,strlen(yystr) ); +} + +/** Setup the input buffer state to scan the given bytes. The next call to convert_lex() will + * scan from a @e copy of @a bytes. + * @param bytes the byte buffer to scan + * @param len the number of bytes in the buffer pointed to by @a bytes. + * + * @return the newly allocated buffer state object. + */ +YY_BUFFER_STATE convert__scan_bytes (yyconst char * yybytes, yy_size_t _yybytes_len ) +{ + YY_BUFFER_STATE b; + char *buf; + yy_size_t n, i; + + /* Get memory for full buffer, including space for trailing EOB's. */ + n = _yybytes_len + 2; + buf = (char *) convert_alloc(n ); + if ( ! buf ) + YY_FATAL_ERROR( "out of dynamic memory in convert__scan_bytes()" ); + + for ( i = 0; i < _yybytes_len; ++i ) + buf[i] = yybytes[i]; + + buf[_yybytes_len] = buf[_yybytes_len+1] = YY_END_OF_BUFFER_CHAR; + + b = convert__scan_buffer(buf,n ); + if ( ! b ) + YY_FATAL_ERROR( "bad buffer in convert__scan_bytes()" ); + + /* It's okay to grow etc. this buffer, and we should throw it + * away when we're done. + */ + b->yy_is_our_buffer = 1; + + return b; +} + +#ifndef YY_EXIT_FAILURE +#define YY_EXIT_FAILURE 2 +#endif + +static void yy_fatal_error (yyconst char* msg ) +{ + (void) fprintf( stderr, "%s\n", msg ); + exit( YY_EXIT_FAILURE ); +} + +/* Redefine yyless() so it works in section 3 code. */ + +#undef yyless +#define yyless(n) \ + do \ + { \ + /* Undo effects of setting up convert_text. */ \ + int yyless_macro_arg = (n); \ + YY_LESS_LINENO(yyless_macro_arg);\ + convert_text[convert_leng] = (yy_hold_char); \ + (yy_c_buf_p) = convert_text + yyless_macro_arg; \ + (yy_hold_char) = *(yy_c_buf_p); \ + *(yy_c_buf_p) = '\0'; \ + convert_leng = yyless_macro_arg; \ + } \ + while ( 0 ) + +/* Accessor methods (get/set functions) to struct members. */ + +/** Get the current line number. + * + */ +int convert_get_lineno (void) +{ + + return convert_lineno; +} + +/** Get the input stream. + * + */ +FILE *convert_get_in (void) +{ + return convert_in; +} + +/** Get the output stream. + * + */ +FILE *convert_get_out (void) +{ + return convert_out; +} + +/** Get the length of the current token. + * + */ +yy_size_t convert_get_leng (void) +{ + return convert_leng; +} + +/** Get the current token. + * + */ + +char *convert_get_text (void) +{ + return convert_text; +} + +/** Set the current line number. + * @param line_number + * + */ +void convert_set_lineno (int line_number ) +{ + + convert_lineno = line_number; +} + +/** Set the input stream. This does not discard the current + * input buffer. + * @param in_str A readable stream. + * + * @see convert__switch_to_buffer + */ +void convert_set_in (FILE * in_str ) +{ + convert_in = in_str ; +} + +void convert_set_out (FILE * out_str ) +{ + convert_out = out_str ; +} + +int convert_get_debug (void) +{ + return convert__flex_debug; +} + +void convert_set_debug (int bdebug ) +{ + convert__flex_debug = bdebug ; +} + +static int yy_init_globals (void) +{ + /* Initialization is the same as for the non-reentrant scanner. + * This function is called from convert_lex_destroy(), so don't allocate here. + */ + + (yy_buffer_stack) = 0; + (yy_buffer_stack_top) = 0; + (yy_buffer_stack_max) = 0; + (yy_c_buf_p) = (char *) 0; + (yy_init) = 0; + (yy_start) = 0; + +/* Defined in main.c */ +#ifdef YY_STDINIT + convert_in = stdin; + convert_out = stdout; +#else + convert_in = (FILE *) 0; + convert_out = (FILE *) 0; +#endif + + /* For future reference: Set errno on error, since we are called by + * convert_lex_init() + */ + return 0; +} + +/* convert_lex_destroy is for both reentrant and non-reentrant scanners. */ +int convert_lex_destroy (void) +{ + + /* Pop the buffer stack, destroying each element. */ + while(YY_CURRENT_BUFFER){ + convert__delete_buffer(YY_CURRENT_BUFFER ); + YY_CURRENT_BUFFER_LVALUE = NULL; + convert_pop_buffer_state(); + } + + /* Destroy the stack itself. */ + convert_free((yy_buffer_stack) ); + (yy_buffer_stack) = NULL; + + /* Reset the globals. This is important in a non-reentrant scanner so the next time + * convert_lex() is called, initialization will occur. */ + yy_init_globals( ); + + return 0; +} + +/* + * Internal utility routines. + */ + +#ifndef yytext_ptr +static void yy_flex_strncpy (char* s1, yyconst char * s2, int n ) +{ + register int i; + for ( i = 0; i < n; ++i ) + s1[i] = s2[i]; +} +#endif + +#ifdef YY_NEED_STRLEN +static int yy_flex_strlen (yyconst char * s ) +{ + register int n; + for ( n = 0; s[n]; ++n ) + ; + + return n; +} +#endif + +void *convert_alloc (yy_size_t size ) +{ + return (void *) malloc( size ); +} + +void *convert_realloc (void * ptr, yy_size_t size ) +{ + /* The cast to (char *) in the following accommodates both + * implementations that use char* generic pointers, and those + * that use void* generic pointers. It works with the latter + * because both ANSI C and C++ allow castless assignment from + * any pointer type to void*, and deal with argument conversions + * as though doing an assignment. + */ + return (void *) realloc( (char *) ptr, size ); +} + +void convert_free (void * ptr ) +{ + free( (char *) ptr ); /* see convert_realloc() for (char *) cast */ +} + +#define YYTABLES_NAME "yytables" + +#line 69 "convert.lex" + + + diff --git a/CROCO/croco-v1.3.1/AGRIF/LIB/run b/CROCO/croco-v1.3.1/AGRIF/LIB/run new file mode 100644 index 00000000..8e99818c --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/LIB/run @@ -0,0 +1,2 @@ +make -f Makefile.lex clean +make -f Makefile.lex diff --git a/CROCO/croco-v1.3.1/AGRIF/LIB/toamr.c b/CROCO/croco-v1.3.1/AGRIF/LIB/toamr.c new file mode 100644 index 00000000..45da8782 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/LIB/toamr.c @@ -0,0 +1,1169 @@ +/******************************************************************************/ +/* */ +/* CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran) */ +/* */ +/* Copyright or or Copr. Laurent Debreu (Laurent.Debreu@imag.fr) */ +/* Cyril Mazauric (Cyril_Mazauric@yahoo.fr) */ +/* This software is governed by the CeCILL-C license under French law and */ +/* abiding by the rules of distribution of free software. You can use, */ +/* modify and/ or redistribute the software under the terms of the CeCILL-C */ +/* license as circulated by CEA, CNRS and INRIA at the following URL */ +/* "http://www.cecill.info". */ +/* */ +/* As a counterpart to the access to the source code and rights to copy, */ +/* modify and redistribute granted by the license, users are provided only */ +/* with a limited warranty and the software's author, the holder of the */ +/* economic rights, and the successive licensors have only limited */ +/* liability. */ +/* */ +/* In this respect, the user's attention is drawn to the risks associated */ +/* with loading, using, modifying and/or developing or reproducing the */ +/* software by the user in light of its specific status of free software, */ +/* that may mean that it is complicated to manipulate, and that also */ +/* therefore means that it is reserved for developers and experienced */ +/* professionals having in-depth computer knowledge. Users are therefore */ +/* encouraged to load and test the software's suitability as regards their */ +/* requirements in conditions enabling the security of their systems and/or */ +/* data to be ensured and, more generally, to use and operate it in the */ +/* same conditions as regards security. */ +/* */ +/* The fact that you are presently reading this means that you have had */ +/* knowledge of the CeCILL-C license and that you accept its terms. */ +/******************************************************************************/ +/* version 1.7 */ +/******************************************************************************/ +#include +#include +#include +#include "decl.h" + +const char * tabvarsname(const variable *var) +{ + static char * tname[5] = { + "tabvars", // v_catvar == 0 + "tabvars_c", // v_catvar == 1 + "tabvars_r", // v_catvar == 2 + "tabvars_l", // v_catvar == 3 + "tabvars_i" // v_catvar == 4 + }; + + return tname[var->v_catvar]; // v_catvar should never be ouside the range [0:4]. +} + +/******************************************************************************/ +/* variablecurgridtabvars */ +/******************************************************************************/ +/* This subroutine is used to create the string */ +/******************************************************************************/ +/* */ +/* -----------> Agrif_Curgrid % tabvars (i) */ +/* */ +/******************************************************************************/ +const char * variablecurgridtabvars(int which_grid) +{ + static char * varname[4] = { + " Agrif_%s(%d)", // which_grid == 0 + " Agrif_%s(%d) %% parent_var", // which_grid == 1 + " Agrif_Mygrid %% %s(%d)", // which_grid == 2 + " Agrif_Curgrid %% %s(%d)", // which_grid == 3 + }; + + return varname[which_grid]; +} + +void WARNING_CharSize(const variable *var) +{ + if ( var->v_nbdim == 0 ) + { + if ( convert2int(var->v_dimchar) > 2400 ) + { + printf("WARNING : The dimension of the character %s \n", var->v_nomvar); + printf(" is upper than 2400. You must change \n"); + printf(" the dimension of carray0 \n"); + printf(" in the file AGRIF/AGRIF_FILES/modtypes.F90 \n"); + printf(" line 161. Replace 2400 with %d. \n", convert2int(var->v_dimchar)+100); + } + Save_Length_int(convert2int(var->v_dimchar),1); + } + else if ( var->v_nbdim == 1 ) + { + if ( convert2int(var->v_dimchar) > 200 ) + { + printf("WARNING : The dimension of the character %s \n", var->v_nomvar); + printf(" is upper than 200. You must change \n"); + printf(" the dimension of carray1 \n"); + printf(" in the file AGRIF/AGRIF_FILES/modtypes.F90 \n"); + printf(" line 162. Replace 200 with %d. \n", convert2int(var->v_dimchar)+100); + } + Save_Length_int(convert2int(var->v_dimchar),2); + } + else if ( var->v_nbdim == 2 ) + { + if ( convert2int(var->v_dimchar) > 200 ) + { + printf("WARNING : The dimension of the character %s \n", var->v_nomvar); + printf(" is upper than 200. You must change \n"); + printf(" the dimension of carray2 \n"); + printf(" in the file AGRIF/AGRIF_FILES/modtypes.F90 \n"); + printf(" line 163. Replace 200 with %d. \n", convert2int(var->v_dimchar)+100); + } + Save_Length_int(convert2int(var->v_dimchar),3); + } + else if ( var->v_nbdim == 3 ) + { + if ( convert2int(var->v_dimchar) > 200 ) + { + printf("WARNING : The dimension of the character %s \n", var->v_nomvar); + printf(" is upper than 200. You must change \n"); + printf(" the dimension of carray3 \n"); + printf(" in the file AGRIF/AGRIF_FILES/modtypes.F90 \n"); + printf(" line 164. Replace 200 with %d. \n", convert2int(var->v_dimchar)+100); + } + Save_Length_int(convert2int(var->v_dimchar),4); + } +} +/******************************************************************************/ +/* vargridnametabvars */ +/******************************************************************************/ +/* This subroutine is used to create the string */ +/******************************************************************************/ +/* */ +/* if iorindice == 0 -----------> Agrif_Gr % tabvars (i) % array1 */ +/* */ +/* if iorindice == 1 -----------> Agrif_Gr % tabvars (12) % array1 */ +/* */ +/******************************************************************************/ +const char *vargridnametabvars (const variable * var, int iorindice) +{ + static char tname_1[LONG_C]; + static char tname_2[LONG_C]; + + if ( iorindice == 0 ) sprintf(tname_1, "Agrif_Gr %% %s(%d)", tabvarsname(var), var->v_indicetabvars); + else sprintf(tname_1, "Agrif_Gr %% %s(i)", tabvarsname(var)); + + if (!strcasecmp(var->v_typevar, "real")) + { + if ( !strcasecmp(var->v_nameinttypename,"8") ) sprintf(tname_2, "%% darray%d", var->v_nbdim); + else if ( !strcasecmp(var->v_nameinttypename,"4") ) sprintf(tname_2, "%% sarray%d", var->v_nbdim); + else if ( !strcasecmp(var->v_precision,"8") ) sprintf(tname_2, "%% darray%d", var->v_nbdim); + else if ( !strcasecmp(var->v_precision,"4") ) sprintf(tname_2, "%% sarray%d", var->v_nbdim); + else + { + sprintf(tname_2, "%% array%d", var->v_nbdim); + } + } + else if (!strcasecmp(var->v_typevar, "integer")) + { + sprintf(tname_2, "%% iarray%d", var->v_nbdim); + } + else if (!strcasecmp(var->v_typevar, "logical")) + { + sprintf(tname_2, "%% larray%d", var->v_nbdim); + } + else if (!strcasecmp(var->v_typevar, "character")) + { + WARNING_CharSize(var); + sprintf (tname_2, "%% carray%d", var->v_nbdim); + } + + strcat(tname_1, tname_2); + Save_Length(tname_1, 46); + + return tname_1; +} + +/******************************************************************************/ +/* vargridcurgridtabvars */ +/******************************************************************************/ +/* This subroutine is used to create the string */ +/******************************************************************************/ +/* */ +/* if which_grid == 0 --> Agrif_Curgrid % tabvars (i) % array1 */ +/* */ +/* if which_grid == 1 --> Agrif_tabvars (i) % parent_var % array1 */ +/* */ +/* if which_grid == 2 --> Agrif_Gr % tabvars (i) % array1 */ +/* */ +/******************************************************************************/ +const char *vargridcurgridtabvars(const variable *var, int which_grid) +{ + static char tname_1[LONG_C]; + static char tname_2[LONG_C]; + + if (!strcasecmp(var->v_typevar,"type")) + { + sprintf(tname_1, "Agrif_%s_var(Agrif_Curgrid%%fixedrank)%%%s", var->v_modulename, var->v_nomvar); + } + else + { + sprintf(tname_1, variablecurgridtabvars(which_grid), tabvarsname(var), var->v_indicetabvars); + + if (!strcasecmp(var->v_typevar, "REAL")) + { + if ( !strcasecmp(var->v_nameinttypename,"8") ) sprintf(tname_2, "darray%d", var->v_nbdim); + else if ( !strcasecmp(var->v_nameinttypename,"4") ) sprintf(tname_2, "sarray%d", var->v_nbdim); + else if ( !strcasecmp(var->v_precision,"8") ) sprintf(tname_2, "darray%d", var->v_nbdim); + else if ( !strcasecmp(var->v_precision,"4") ) sprintf(tname_2, "sarray%d", var->v_nbdim); + else sprintf(tname_2, "array%d", var->v_nbdim); + } + else if (!strcasecmp(var->v_typevar, "INTEGER")) + { + sprintf(tname_2, "iarray%d", var->v_nbdim); + } + else if (!strcasecmp(var->v_typevar, "LOGICAL")) + { + sprintf(tname_2, "larray%d", var->v_nbdim); + } + else if (!strcasecmp(var->v_typevar, "CHARACTER")) + { + WARNING_CharSize(var); + sprintf(tname_2, "carray%d", var->v_nbdim); + } + if (var->v_pointerdeclare) + { + strcat(tname_1,"%p"); + strcat(tname_1, tname_2); + } + else + { + strcat(tname_1,"%"); + strcat(tname_1, tname_2); + } + } + Save_Length(tname_1, 46); + + return tname_1; +} + +/******************************************************************************/ +/* vargridcurgridtabvarswithoutAgrif_Gr */ +/******************************************************************************/ +/* This subroutine is used to create the string */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +const char *vargridcurgridtabvarswithoutAgrif_Gr(const variable *var) +{ + static char tname_1[LONG_C]; + static char tname_2[LONG_C]; + + sprintf(tname_1, "(%d)", var->v_indicetabvars); + + if (!strcasecmp(var->v_typevar, "REAL")) + { + if ( !strcasecmp(var->v_nameinttypename,"8") ) sprintf(tname_2, "darray%d", var->v_nbdim); + else if ( !strcasecmp(var->v_nameinttypename,"4") ) sprintf(tname_2, "sarray%d", var->v_nbdim); + else if ( !strcasecmp(var->v_precision,"8") ) sprintf(tname_2, "darray%d", var->v_nbdim); + else if ( !strcasecmp(var->v_precision,"4") ) sprintf(tname_2, "sarray%d", var->v_nbdim); + else sprintf(tname_2, "array%d", var->v_nbdim); + } + else if (!strcasecmp(var->v_typevar, "INTEGER")) + { + sprintf(tname_2, "iarray%d", var->v_nbdim); + } + else if (!strcasecmp(var->v_typevar, "LOGICAL")) + { + sprintf(tname_2, "larray%d", var->v_nbdim); + } + else if (!strcasecmp(var->v_typevar, "CHARACTER")) + { + WARNING_CharSize(var); + sprintf(tname_2, "carray%d", var->v_nbdim); + } + if (var->v_pointerdeclare) + { + strcat(tname_1,"%p"); + strcat(tname_1, tname_2); + } + else + { + strcat(tname_1,"%"); + strcat(tname_1, tname_2); + } + + Save_Length(tname_1, 46); + + return tname_1; +} + +/******************************************************************************/ +/* vargridparam */ +/******************************************************************************/ +/* This subroutine is used to create the string which contains */ +/* dimension list */ +/******************************************************************************/ +/* */ +/* DIMENSION(jpi,0:jpj) ----------->"1:jpi,0:jpj" */ +/* */ +/******************************************************************************/ +const char * vargridparam(const variable *var) +{ + typedim dim; + listdim *newdim; + char newname[LONG_M]; + + newdim = var->v_dimension; + if (!newdim) return ""; + + strcpy (tmpvargridname, "("); + while (newdim) + { + dim = newdim->dim; + strcpy(newname,ChangeTheInitalvaluebyTabvarsName(dim.first,List_Global_Var)); + strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname,List_Common_Var)); + strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname,List_ModuleUsed_Var)); + strcat(tmpvargridname, newname); + strcat(tmpvargridname, " : "); + strcpy(newname,ChangeTheInitalvaluebyTabvarsName(dim.last,List_Global_Var)); + strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname, List_Common_Var)); + strcpy(newname,ChangeTheInitalvaluebyTabvarsName(newname, List_ModuleUsed_Var)); + strcat(tmpvargridname, newname); + newdim = newdim->suiv; + if (newdim) strcat(tmpvargridname, ","); + } + strcat(tmpvargridname, ")\0"); + Save_Length(tmpvargridname,40); + return tmpvargridname; +} + +/******************************************************************************/ +/* write_probdimagrif_file */ +/******************************************************************************/ +/* This subroutine is used to create the file probdim_agrif.h */ +/******************************************************************************/ +/* */ +/* probdim_agrif.h */ +/* */ +/* Agrif_probdim = */ +/* */ +/******************************************************************************/ +void write_probdimagrif_file() +{ + FILE *probdim; + char ligne[LONG_M]; + + probdim = open_for_write("probdim_agrif.h"); + sprintf (ligne, "Agrif_Probdim = %d", dimprob); + tofich (probdim, ligne,1); + fclose (probdim); +} + +/******************************************************************************/ +/* write_keysagrif_file */ +/******************************************************************************/ +/* This subroutine is used to create the file keys_agrif.h */ +/******************************************************************************/ +/* */ +/* keys_agrif.h */ +/* */ +/* AGRIF_USE_FIXED_GRIDS = 0 */ +/* AGRIF_USE_ONLY_FIXED_GRIDS = 0 */ +/* AGRIF_USE_(ONLY)_FIXED_GRIDS = 1 */ +/* */ +/******************************************************************************/ +void write_keysagrif_file() +{ + FILE *keys; + + keys = open_for_write("keys_agrif.h"); + fprintf(keys," AGRIF_USE_FIXED_GRIDS = %d\n", fixedgrids); + fprintf(keys," AGRIF_USE_ONLY_FIXED_GRIDS = %d\n", onlyfixedgrids); + fclose(keys); +} + +/******************************************************************************/ +/* write_modtypeagrif_file */ +/******************************************************************************/ +/* This subroutine is used to create the file typedata */ +/******************************************************************************/ +/* */ +/* modtype_agrif.h */ +/* */ +/* Agrif_NbVariables = */ +/* */ +/******************************************************************************/ +void write_modtypeagrif_file() +{ + char ligne[LONG_M]; + FILE *typedata; + int i; + + typedata = open_for_write("modtype_agrif.h"); + /* AGRIF_NbVariables : number of variables */ + for (i=0;iv_indicetabvars,v->v_nomvar); + tofich(createvarname,ligne,1); +} + +/******************************************************************************/ +/* write_Setnumberofcells_file */ +/******************************************************************************/ +/* This subroutine is used to create the file setnumberofcells */ +/******************************************************************************/ +/* */ +/* Agrif_Gr % n(i) = nbmailles */ +/* */ +/******************************************************************************/ +void write_Setnumberofcells_file() +{ + char ligne[LONG_VNAME]; + char cformat[LONG_VNAME]; + FILE *setnumberofcells; + + if ( IndicenbmaillesX == 0 ) return; + + setnumberofcells = open_for_write("SetNumberofcells.h"); + + if ( onlyfixedgrids == 1 ) + strcpy(cformat, "Agrif_Gr %% nb(%d) = Agrif_Curgrid %% tabvars_i(%d) %% iarray0"); + else + strcpy(cformat, "Agrif_Gr %% nb(%d) = Agrif_Gr %% tabvars_i(%d) %% iarray0"); + + sprintf(ligne, cformat, 1, IndicenbmaillesX); + tofich(setnumberofcells, ligne, 1); + + if ( dimprob > 1 ) + { + sprintf(ligne, cformat, 2, IndicenbmaillesY); + tofich(setnumberofcells, ligne, 1); + } + if ( dimprob > 2 ) + { + sprintf(ligne, cformat, 3, IndicenbmaillesZ); + tofich(setnumberofcells, ligne, 1); + } + fclose(setnumberofcells); +} + +/******************************************************************************/ +/* write_Getnumberofcells_file */ +/******************************************************************************/ +/* This subroutine is used to create the file getnumberofcells */ +/******************************************************************************/ +/* */ +/* nbmailles = Agrif_Gr % n(i) */ +/* */ +/******************************************************************************/ +void write_Getnumberofcells_file() +{ + char ligne[LONG_VNAME]; + char cformat[LONG_VNAME]; + FILE *getnumberofcells; + + if ( IndicenbmaillesX == 0 ) return; + + strcpy(cformat, "Agrif_Curgrid %% tabvars_i(%d) %% iarray0 = Agrif_Gr %% nb(%d)"); + + getnumberofcells = open_for_write("GetNumberofcells.h"); + + sprintf(ligne, cformat, IndicenbmaillesX, 1); + tofich(getnumberofcells, ligne, 1); + + if (dimprob > 1) + { + sprintf(ligne, cformat, IndicenbmaillesY, 2); + tofich(getnumberofcells, ligne,1); + } + if (dimprob > 2) + { + sprintf(ligne, cformat, IndicenbmaillesZ, 3); + tofich(getnumberofcells, ligne,1); + } + fclose(getnumberofcells); +} + + +/******************************************************************************/ +/* write_initialisationsagrif_file */ +/******************************************************************************/ +/* This subroutine is used to create the file initproc */ +/******************************************************************************/ +/* */ +/* ! variable */ +/* Agrif_Gr % tabvars(i) % nbdim = 1 */ +/* */ +/******************************************************************************/ +void write_initialisationsagrif_file(variable *v,FILE *initproc,int *VarnameEmpty) +{ + char ligne[LONG_M]; + + if ( v->v_nbdim != 0 ) + { + *VarnameEmpty = 0 ; + sprintf(ligne,"Agrif_Mygrid %% %s(%d) %% nbdim = %d", tabvarsname(v), v->v_indicetabvars, v->v_nbdim); + tofich (initproc, ligne,1); + } +} + + +void Write_Alloc_Agrif_Files() +{ + listnom *parcours; + FILE *alloccalls; + FILE *AllocUSE; + + AllocUSE= open_for_write("include_use_Alloc_agrif.h"); + alloccalls = open_for_write("allocations_calls_agrif.h"); + + parcours = List_Subroutine_For_Alloc; + while ( parcours ) + { + fprintf(AllocUSE," use %s, only: Alloc_agrif_%s\n", parcours -> o_nom, parcours -> o_nom ); + fprintf (alloccalls," call Alloc_agrif_%s(Agrif_Gr)\n", parcours -> o_nom ); + parcours = parcours -> suiv; + } + + fclose (AllocUSE); + fclose (alloccalls); +} + +int IndiceInlist(int indic, listindice *listin) +{ + listindice *parcoursindic; + int out; + + out = 0 ; + + parcoursindic = listin; + while ( parcoursindic && out == 0 ) + { + if ( parcoursindic->i_indice == indic ) out = 1; + else parcoursindic = parcoursindic -> suiv; + } + + return out; +} + +void write_allocation_Common_0() +{ + listnom *parcours_nom; + listnom *neededparameter; + listvar *parcours; + listvar *parcoursprec; + listvar *parcours1; + listname *parcours_name; + listname *parcours_name_array; + listdoloop *parcours_loop; + FILE *allocationagrif; + FILE *paramtoamr; + char ligne[LONG_M]; + char ligne2[LONG_M]; + char ligne3[LONG_M]; + variable *v; + int IndiceMax; + int IndiceMin; + int compteur; + int out; + int indiceprec; + int ValeurMax; + char initialvalue[LONG_M]; + listindice **list_indic; + listindice *parcoursindic; + int i; + int nb_initial; + int is_parameter_local; + int global_check; + + parcoursprec = (listvar *) NULL; + parcours_nom = List_NameOfCommon; + ValeurMax = 2; + while ( parcours_nom ) + { + if ( parcours_nom->o_val == 1 ) + { + /* Open the file to create the Alloc_agrif subroutine */ + sprintf(ligne,"alloc_agrif_%s.h",parcours_nom->o_nom); + allocationagrif = open_for_write(ligne); + + fprintf(allocationagrif,"#include \"Param_toamr_%s.h\" \n", parcours_nom->o_nom); + sprintf(ligne,"Param_toamr_%s.h",parcours_nom->o_nom); + paramtoamr = open_for_write(ligne); + neededparameter = (listnom *) NULL; + list_indic = (listindice **) calloc(NB_CAT_VARIABLES,sizeof(listindice *)); + + shouldincludempif = 1 ; + parcours = List_Common_Var; + while ( parcours ) + { + if ( !strcasecmp(parcours->var->v_commonname,parcours_nom->o_nom) && + IndiceInlist(parcours->var->v_indicetabvars,list_indic[parcours->var->v_catvar]) == 0 ) + { + v = parcours->var; + IndiceMax = 0; + IndiceMin = indicemaxtabvars[v->v_catvar]; + /* body of the file */ + if ( !strcasecmp(v->v_commoninfile,cur_filename) ) + { + if ( (onlyfixedgrids != 1) && (v->v_nbdim != 0) ) + { + sprintf(ligne,"if (.not. allocated(%s)) then", vargridnametabvars(v,0)); + tofich(allocationagrif,ligne,1); + } + if ( (v->v_allocatable != 1) && (v->v_dimsempty != 1) ) + { + /* ALLOCATION */ + if ( v->v_dimension != 0 ) + { + if ( v->v_indicetabvars < IndiceMin || v->v_indicetabvars > IndiceMax ) + { + parcours1 = parcours; + compteur = -1; + out = 0; + indiceprec = parcours->var->v_indicetabvars -1 ; + while ( parcours1 && out == 0 + && !strcasecmp(parcours->var->v_readedlistdimension,parcours1->var->v_readedlistdimension) + && !strcasecmp(parcours->var->v_typevar, parcours1->var->v_typevar) + && (parcours1->var->v_indicetabvars == indiceprec+1) ) + { + if ( !strcasecmp(parcours1->var->v_modulename,parcours_nom->o_nom) || + !strcasecmp(parcours1->var->v_commonname,parcours_nom->o_nom) ) + { + compteur = compteur +1 ; + indiceprec = parcours1->var->v_indicetabvars; + parcoursprec = parcours1; + parcours1 = parcours1->suiv; + } + else out = 1; + } + sprintf(ligne,"!! ALLOCATION OF VARIABLE : %s",v->v_nomvar); + tofich(allocationagrif,ligne,1); + if ( compteur > ValeurMax ) + { + sprintf(ligne,"do i = %d,%d", parcours->var->v_indicetabvars, + parcours->var->v_indicetabvars+compteur); + tofich(allocationagrif,ligne,1); + IndiceMin = parcours->var->v_indicetabvars; + IndiceMax = parcours->var->v_indicetabvars+compteur; + sprintf(ligne," if (.not. allocated(%s)) then", vargridnametabvars(v,1)); + tofich(allocationagrif,ligne,1); + sprintf(ligne," allocate(%s", vargridnametabvars(v,1)); + sprintf(ligne2,"%s)", vargridparam(v)); + strcat(ligne,ligne2); + tofich(allocationagrif,ligne,1); + if (!strcasecmp(parcours->var->v_typevar,"real") || !strcasecmp(parcours->var->v_typevar,"integer")) + { + sprintf(ligne," %s = 0", vargridnametabvars(v,1)); + tofich(allocationagrif,ligne,1); + } + tofich(allocationagrif,"endif",1); + tofich(allocationagrif,"enddo",1); + i = parcours->var->v_indicetabvars; + do + { + parcoursindic = (listindice *)calloc(1,sizeof(listindice)); + parcoursindic -> i_indice = i; + parcoursindic -> suiv = list_indic[parcours->var->v_catvar]; + list_indic[parcours->var->v_catvar] = parcoursindic; + i = i + 1; + } while ( i <= parcours->var->v_indicetabvars+compteur ); + parcours = parcoursprec; + } + else + { + sprintf(ligne," if (.not. allocated(%s)) then", vargridnametabvars(v,0)); + tofich(allocationagrif,ligne,1); + sprintf(ligne," allocate(%s", vargridnametabvars(v,0)); + sprintf(ligne2,"%s)", vargridparam(v)); + strcat(ligne,ligne2); + tofich(allocationagrif,ligne,1); + if (!strcasecmp(parcours->var->v_typevar,"real") || !strcasecmp(parcours->var->v_typevar,"integer")) + { + sprintf(ligne," %s = 0", vargridnametabvars(v,0)); + tofich(allocationagrif,ligne,1); + } + tofich(allocationagrif,"endif",1); + + parcoursindic = (listindice *) calloc(1,sizeof(listindice)); + parcoursindic -> i_indice = parcours->var->v_indicetabvars; + parcoursindic -> suiv = list_indic[parcours->var->v_catvar]; + list_indic[parcours->var->v_catvar] = parcoursindic; + } + + global_check = 0; + is_parameter_local = writedeclarationintoamr(List_Parameter_Var, + paramtoamr,v,parcours_nom->o_nom,&neededparameter,v->v_commonname,global_check); + if (is_parameter_local == 0) + { + global_check = 1; + is_parameter_local = writedeclarationintoamr(List_GlobalParameter_Var, + paramtoamr,v,parcours_nom->o_nom,&neededparameter,v->v_commonname,global_check); + } + } + } /* end of the allocation part */ + /* INITIALISATION */ + if ( v->v_initialvalue ) + { + parcours_name = v->v_initialvalue; + parcours_name_array = v->v_initialvalue_array; + if (parcours_name_array) + { + while (parcours_name) + { + strcpy(ligne, vargridnametabvars(v,0)); + if (parcours_name_array) + { + if (strcasecmp(parcours_name_array->n_name,"") ) + { + sprintf(ligne2,"(%s)",parcours_name_array->n_name); + strcat(ligne,ligne2); + } + } + /* We should modify the initialvalue in the case of variable has been defined with others variables */ + strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(parcours_name->n_name,List_Global_Var)); + if ( !strcasecmp(initialvalue,parcours_name->n_name) ) + { + strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(parcours_name->n_name,List_Common_Var)); + } + if ( !strcasecmp(initialvalue,parcours_name->n_name) ) + { + strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(parcours_name->n_name,List_ModuleUsed_Var)); + } + strcat (ligne," = "); + + if (v->v_nbdim >= 0) + { + strcpy(ligne2,initialvalue); + } + else + { + sprintf(ligne2,"reshape(%s,shape(%s))",initialvalue,vargridnametabvars(v,0)); + } + strcat(ligne,ligne2); + tofich(allocationagrif,ligne,1); + + parcours_name = parcours_name->suiv; + if (parcours_name_array) parcours_name_array = parcours_name_array->suiv; + } + } + else + { + strcpy(ligne, vargridnametabvars(v,0)); + strcat (ligne," = "); + strcpy(ligne2,""); + nb_initial = 0; + + while (parcours_name) + { + nb_initial = nb_initial + 1; + /* We should modify the initialvalue in the case of variable has been defined with others variables */ + strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(parcours_name->n_name,List_Global_Var)); + if ( !strcasecmp(initialvalue,parcours_name->n_name) ) + { + strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(parcours_name->n_name,List_Common_Var)); + } + if ( !strcasecmp(initialvalue,parcours_name->n_name) ) + { + strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(parcours_name->n_name,List_ModuleUsed_Var)); + } + + strcat(ligne2,initialvalue); + if (parcours_name->suiv) + { + strcat(ligne2,","); + } + + parcours_name = parcours_name->suiv; + } + if (nb_initial > 1) + { + sprintf(ligne3,"reshape((/%s/),shape(%s))",ligne2,vargridnametabvars(v,0)); + } + else + { + strcpy(ligne3,ligne2); + } + strcat(ligne,ligne3); + tofich(allocationagrif,ligne,1); + } + } + } + if ( (onlyfixedgrids != 1) && (v->v_nbdim != 0) ) + { + tofich(allocationagrif,"endif",1); + } + } + } + parcours = parcours -> suiv; + } + /* Close the file Alloc_agrif */ + fclose(allocationagrif); + fclose(paramtoamr); + } + parcours_nom = parcours_nom -> suiv; + } +} + +void write_allocation_Global_0() +{ + listnom *parcours_nom; + listvar *parcours; + listvar *parcoursprec; + listvar *parcours1; + FILE *allocationagrif; + char ligne[LONG_M]; + char ligne2[LONG_M]; + char ligne3[LONG_M]; + listname *parcours_name; + listname *parcours_name_array; + variable *v; + int IndiceMax; + int IndiceMin; + int compteur; + int out; + int indiceprec; + int ValeurMax; + char initialvalue[LONG_M]; + int typeiswritten ; + int nb_initial; + + parcoursprec = (listvar *) NULL; + parcours_nom = List_NameOfModule; + ValeurMax = 2; + + while ( parcours_nom ) + { + if ( parcours_nom->o_val == 1 ) + { + IndiceMax = 0; + IndiceMin = indicemaxtabvars[0]; + /* Open the file to create the Alloc_agrif subroutine */ + sprintf(ligne,"alloc_agrif_%s.h",parcours_nom->o_nom); + allocationagrif = open_for_write(ligne); + +// if ( ModuleIsDefineInInputFile(parcours_nom->o_nom) == 1 ) +// { +// /* add the call to initworkspace */ +// tofich(allocationagrif,"if (.not. Agrif_Root() ) then",1); +// tofich(allocationagrif,"#include \"GetNumberofcells.h\"\n",0); +// tofich(allocationagrif,"else",1); +// tofich(allocationagrif,"#include \"SetNumberofcells.h\"\n",0); +// tofich(allocationagrif,"endif",1); +// tofich(allocationagrif,"call Agrif_InitWorkspace",1); +// } + + typeiswritten = 0; + parcours = List_Global_Var; + while ( parcours ) + { + if ( !strcasecmp(parcours->var->v_modulename,parcours_nom->o_nom) && + parcours->var->v_VariableIsParameter == 0 && + parcours->var->v_notgrid == 0 ) + { + v = parcours->var; + IndiceMax = 0; + IndiceMin = indicemaxtabvars[v->v_catvar]; + /* body of the file */ + if ( !strcasecmp(v->v_commoninfile,cur_filename) ) + { + if ( (onlyfixedgrids != 1) && (v->v_nbdim != 0) ) + { + sprintf(ligne,"if (.not. allocated(%s)) then", vargridnametabvars(v,0)); + tofich(allocationagrif,ligne,1); + } + if ( (v->v_allocatable != 1) && (v->v_dimsempty != 1) ) + { + /* ALLOCATION */ + if ( v->v_dimension != 0 ) + { + if ( v->v_indicetabvars < IndiceMin || v->v_indicetabvars > IndiceMax ) + { + parcours1 = parcours; + compteur = -1; + out = 0; + indiceprec = parcours->var->v_indicetabvars -1 ; + while ( parcours1 && out == 0 + && !strcasecmp(parcours->var->v_readedlistdimension,parcours1->var->v_readedlistdimension) + && !strcasecmp(parcours->var->v_typevar, parcours1->var->v_typevar) + && (parcours1->var->v_indicetabvars == indiceprec+1) ) + { + if ( !strcasecmp(parcours1->var->v_modulename, parcours_nom->o_nom) || + !strcasecmp(parcours1->var->v_commonname, parcours_nom->o_nom) ) + { + compteur = compteur +1 ; + indiceprec = parcours1->var->v_indicetabvars; + parcoursprec = parcours1; + parcours1 = parcours1->suiv; + } + else out = 1; + } + sprintf(ligne,"!! ALLOCATION OF VARIABLE : %s",v->v_nomvar); + tofich(allocationagrif,ligne,1); + if ( compteur > ValeurMax ) + { + sprintf(ligne,"do i = %d,%d", parcours->var->v_indicetabvars, + parcours->var->v_indicetabvars+compteur); + tofich(allocationagrif,ligne,1); + IndiceMin = parcours->var->v_indicetabvars; + IndiceMax = parcours->var->v_indicetabvars+compteur; + sprintf(ligne," if (.not. allocated(%s)) then", vargridnametabvars(v,1)); + tofich(allocationagrif,ligne,1); + sprintf(ligne," allocate(%s", vargridnametabvars(v,1)); + sprintf(ligne2,"%s)", vargridparam(v)); + strcat(ligne,ligne2); + tofich(allocationagrif,ligne,1); + if (!strcasecmp(parcours->var->v_typevar,"real") || !strcasecmp(parcours->var->v_typevar,"integer")) + { + sprintf(ligne," %s = 0", vargridnametabvars(v,1)); + tofich(allocationagrif,ligne,1); + } + tofich(allocationagrif,"endif",1); + tofich(allocationagrif,"enddo",1); + parcours = parcoursprec; + } + else + { + sprintf(ligne," if (.not. allocated(%s)) then", vargridnametabvars(v,0)); + tofich(allocationagrif,ligne,1); + sprintf(ligne," allocate(%s", vargridnametabvars(v,0)); + sprintf(ligne2,"%s)", vargridparam(v)); + strcat(ligne,ligne2); + tofich(allocationagrif,ligne,1); + if (!strcasecmp(parcours->var->v_typevar,"real") || !strcasecmp(parcours->var->v_typevar,"integer")) + { + sprintf(ligne," %s = 0", vargridnametabvars(v,0)); + tofich(allocationagrif,ligne,1); + } + tofich(allocationagrif,"endif",1); + } + } + } /* end of the allocation part */ + /* INITIALISATION */ + + if ( v->v_initialvalue ) + { + parcours_name = v->v_initialvalue; + parcours_name_array = v->v_initialvalue_array; + if (parcours_name_array) + { + while (parcours_name) + { + strcpy(ligne, vargridnametabvars(v,0)); + if (parcours_name_array) + { + if (strcasecmp(parcours_name_array->n_name,"") ) + { + sprintf(ligne2,"(%s)",parcours_name_array->n_name); + strcat(ligne,ligne2); + } + } + /* We should modify the initialvalue in the case of variable has been defined with others variables */ + strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(parcours_name->n_name,List_Global_Var)); + if ( !strcasecmp(initialvalue,parcours_name->n_name) ) + { + strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(parcours_name->n_name,List_Common_Var)); + } + if ( !strcasecmp(initialvalue,parcours_name->n_name) ) + { + strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(parcours_name->n_name,List_ModuleUsed_Var)); + } + strcat (ligne," = "); + + if (v->v_nbdim >= 0) + { + strcpy(ligne2,initialvalue); + } + else + { + sprintf(ligne2,"reshape(%s,shape(%s))",initialvalue,vargridnametabvars(v,0)); + } + strcat(ligne,ligne2); + tofich(allocationagrif,ligne,1); + + parcours_name = parcours_name->suiv; + if (parcours_name_array) parcours_name_array = parcours_name_array->suiv; + } + } + else + { + strcpy(ligne, vargridnametabvars(v,0)); + strcat (ligne," = "); + strcpy(ligne2,""); + nb_initial = 0; + + while (parcours_name) + { + nb_initial = nb_initial + 1; + /* We should modify the initialvalue in the case of variable has been defined with others variables */ + strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(parcours_name->n_name,List_Global_Var)); + if ( !strcasecmp(initialvalue,parcours_name->n_name) ) + { + strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(parcours_name->n_name,List_Common_Var)); + } + if ( !strcasecmp(initialvalue,parcours_name->n_name) ) + { + strcpy(initialvalue,ChangeTheInitalvaluebyTabvarsName(parcours_name->n_name,List_ModuleUsed_Var)); + } + + strcat(ligne2,initialvalue); + if (parcours_name->suiv) + { + strcat(ligne2,","); + } + + parcours_name = parcours_name->suiv; + } + if (nb_initial > 1) + { + sprintf(ligne3,"reshape((/%s/),shape(%s))",ligne2,vargridnametabvars(v,0)); + } + else + { + strcpy(ligne3,ligne2); + } + strcat(ligne,ligne3); + tofich(allocationagrif,ligne,1); + } + } + } + /* Case of structure types */ + if ( (typeiswritten == 0) && !strcasecmp(v->v_typevar,"type") ) + { + sprintf(ligne,"if (.not. allocated(Agrif_%s_var)) then",v->v_modulename); + tofich(allocationagrif, ligne, 1); + sprintf(ligne," allocate(Agrif_%s_var(0:Agrif_NbMaxGrids))",v->v_modulename); + tofich(allocationagrif, ligne, 1); + tofich(allocationagrif, "endif", 1); + typeiswritten = 1; + } + if ( (onlyfixedgrids != 1) && (v->v_nbdim != 0) ) + { + tofich(allocationagrif,"endif",1); + } + } + } + parcours = parcours -> suiv; + } + if ( ModuleIsDefineInInputFile(parcours_nom->o_nom) == 1 ) + { + fprintf(allocationagrif, " if ( .not.Agrif_Root() ) then\n"); + fprintf(allocationagrif, "#include \"GetNumberofcells.h\"\n"); + fprintf(allocationagrif, " else\n"); + fprintf(allocationagrif, "#include \"SetNumberofcells.h\"\n"); + fprintf(allocationagrif, " endif\n"); + fprintf(allocationagrif, " call Agrif_InitWorkspace\n"); + } + fclose(allocationagrif); + } + parcours_nom = parcours_nom -> suiv; + } +} + +/******************************************************************************/ +/* creefichieramr */ +/******************************************************************************/ +/* This subroutine is the main one to create AGRIF_INC files */ +/******************************************************************************/ +/* */ +/******************************************************************************/ +void creefichieramr () +{ + listvar *newvar; + variable *v; + int erreur; + char filefich[LONG_M]; + + int InitEmpty; + int VarnameEmpty; + int donotwrite; + + FILE *initproc; + FILE *initglobal; + FILE *createvarname; + FILE *createvarnameglobal; + + if ( todebug == 1 ) printf("Enter in creefichieramr\n"); + + sprintf(filefich, "cd %s", include_dir); + erreur = system (filefich); + if (erreur) + { + sprintf(filefich, "mkdir -p %s", include_dir); + system(filefich); + printf("%s: Directory created\n", include_dir); + } + +/******************************************************************************/ +/******************** Creation of AGRIF_INC files *****************************/ +/******************************************************************************/ + + if ( todebug == 1 ) + { + const char *NameTampon = "toto"; + sprintf(filefich,"initialisations_agrif_%s.h", NameTampon); + initproc = open_for_write(filefich); + + sprintf(filefich,"createvarname_agrif_%s.h", NameTampon); + createvarname = open_for_write(filefich); + + InitEmpty = 1 ; + VarnameEmpty = 1 ; + + newvar = List_Global_Var; + while ( newvar ) + { + donotwrite = 0; + v = newvar->var; + + if ( ( v->v_common == 1 || v->v_module == 1 ) && donotwrite == 0 ) + { + write_createvarnameagrif_file(v,createvarname,&VarnameEmpty); + write_initialisationsagrif_file(v,initproc,&InitEmpty); + } + newvar = newvar->suiv; + } + fclose (createvarname); + fclose (initproc); + + if ( is_dependfile_created(curmodulename) == 0 ) + { + if ( InitEmpty != 1 ) + { + initglobal = open_for_append("initialisations_agrif.h"); + fprintf(initglobal,"#include \"initialisations_agrif_%s.h\"\n", NameTampon); + fclose(initglobal); + } + if ( VarnameEmpty != 1 ) + { + createvarnameglobal= open_for_append("createvarname_agrif.h"); + fprintf(createvarnameglobal,"#include \"createvarname_agrif_%s.h\"\n", NameTampon); + fclose(createvarnameglobal); + } + } + } + write_allocation_Common_0(); + write_allocation_Global_0(); + + Write_Alloc_Agrif_Files(); + write_probdimagrif_file(); + write_keysagrif_file(); + write_modtypeagrif_file(); + + if ( NbMailleXDefined == 1 ) + { + write_Setnumberofcells_file(); + write_Getnumberofcells_file(); + } + + if ( todebug == 1 ) printf("Out of creefichieramr\n"); +} diff --git a/CROCO/croco-v1.3.1/AGRIF/Makefile b/CROCO/croco-v1.3.1/AGRIF/Makefile new file mode 100644 index 00000000..e3265354 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/Makefile @@ -0,0 +1,133 @@ +#- Creation des elements relatifs a AGRIF (lib, config) +#--------------------------------------------------------------------- +SHELL = /bin/sh +#--------------------------------------------------------------------- + +DIR_OBJS = AGRIF_OBJS +DIR_FILES = AGRIF_FILES +DIR_YOURFILES = AGRIF_YOURFILES + +FILENAMES = modprocs modseq modbc modcluster modinit modinitvars modinterp modinterpbasic \ + modtypes modgrids modbcfunction modutil modcurgridfunctions \ + modmask modsauv modupdate modmpp \ + modupdatebasic modlinktomodel modarrays modvariables + +OBJS=$(addsuffix .o,$(addprefix $(DIR_OBJS)/,$(FILENAMES))) +FILES=$(addsuffix .F90,$(addprefix $(DIR_FILES)/,$(FILENAMES))) + +all: conv libagrif.a + @echo + @echo =================================================== + @echo AGRIF is OK + @echo =================================================== + @echo + +.PHONY: conv + +conv: + @echo + @echo =================================================== + @echo Compile conv... + @echo =================================================== + $(MAKE) -C LIB conv + mv -f LIB/conv . + +libagrif.a : prep_lib $(OBJS) + $(AR) -r $@ $(OBJS) + ranlib $@ + +prep_lib: + @echo + @echo =================================================== + @echo Compile Agrif library... + @echo =================================================== + mkdir -p $(DIR_YOURFILES) + mkdir -p $(DIR_OBJS) + +$(DIR_OBJS)/%.o : $(DIR_FILES)/%.F90 + $(RM) $(DIR_YOURFILES)/$(*F).f90 + $(CPP) $(CPPFLAGS) $(DIR_FILES)/$(*F).F90 > $(DIR_YOURFILES)/$(*F).f90 + $(FC) $(FFLAGS) -I.. -c $(DIR_YOURFILES)/$(*F).f90 -o $(DIR_OBJS)/$(*F).o + +$(DIR_OBJS)/modarrays.o: $(DIR_OBJS)/modgrids.o + +$(DIR_OBJS)/modbc.o: $(DIR_OBJS)/modinterp.o + +$(DIR_OBJS)/modbcfunction.o: $(DIR_OBJS)/modupdate.o \ + $(DIR_OBJS)/modbc.o \ + $(DIR_OBJS)/modinterp.o \ + $(DIR_OBJS)/modtypes.o + +$(DIR_OBJS)/modcluster.o: $(DIR_OBJS)/modtypes.o \ + $(DIR_OBJS)/modlinktomodel.o \ + $(DIR_OBJS)/modsauv.o \ + $(DIR_OBJS)/modinitvars.o \ + $(DIR_OBJS)/modseq.o \ + $(DIR_OBJS)/modcurgridfunctions.o + +$(DIR_OBJS)/modcurgridfunctions.o: $(DIR_OBJS)/modinit.o \ + $(DIR_OBJS)/modtypes.o + +$(DIR_OBJS)/modinit.o: $(DIR_OBJS)/modlinktomodel.o \ + $(DIR_OBJS)/modtypes.o \ + $(DIR_OBJS)/modmpp.o + +$(DIR_OBJS)/modinitvars.o: $(DIR_OBJS)/modlinktomodel.o \ + $(DIR_OBJS)/modgrids.o + +$(DIR_OBJS)/modinterpbasic.o: $(DIR_OBJS)/modtypes.o + +$(DIR_OBJS)/modinterp.o: $(DIR_OBJS)/modcurgridfunctions.o \ + $(DIR_OBJS)/modmask.o \ + $(DIR_OBJS)/modarrays.o \ + $(DIR_OBJS)/modmpp.o \ + $(DIR_OBJS)/modinterpbasic.o + +$(DIR_OBJS)/modlinktomodel.o: $(DIR_OBJS)/modgrids.o + +$(DIR_OBJS)/modgrids.o: $(DIR_OBJS)/modtypes.o + +$(DIR_OBJS)/modmask.o: $(DIR_OBJS)/modtypes.o + +$(DIR_OBJS)/modsauv.o: $(DIR_OBJS)/modarrays.o $(DIR_OBJS)/modlinktomodel.o \ + $(DIR_OBJS)/modtypes.o $(DIR_OBJS)/modvariables.o + +$(DIR_OBJS)/modupdatebasic.o: $(DIR_OBJS)/modtypes.o + +$(DIR_OBJS)/modupdate.o: $(DIR_OBJS)/modmask.o \ + $(DIR_OBJS)/modcurgridfunctions.o \ + $(DIR_OBJS)/modarrays.o \ + $(DIR_OBJS)/modmpp.o \ + $(DIR_OBJS)/modupdatebasic.o + +$(DIR_OBJS)/modutil.o: $(DIR_OBJS)/modtypes.o \ + $(DIR_OBJS)/modcurgridfunctions.o \ + $(DIR_OBJS)/modlinktomodel.o \ + $(DIR_OBJS)/modsauv.o \ + $(DIR_OBJS)/modcluster.o \ + $(DIR_OBJS)/modseq.o + +$(DIR_OBJS)/modmpp.o: $(DIR_OBJS)/modgrids.o \ + $(DIR_OBJS)/modarrays.o + +$(DIR_OBJS)/modseq.o: $(DIR_OBJS)/modinit.o \ + $(DIR_OBJS)/modarrays.o \ + $(DIR_OBJS)/modprocs.o + +.PHONY: doc doc_user + +doc: + (cd doc ; doxygen Doxyfile ) + +doc_user: + (cd doc ; doxygen Doxyfile_user ) + +clean: clean-conv + $(RM) libagrif.a *.mod $(DIR_OBJS)/* $(DIR_YOURFILES)/* + +clean-all: clean + $(MAKE) -C LIB clean-all + +clean-conv: + $(MAKE) -C LIB clean + $(RM) conv diff --git a/CROCO/croco-v1.3.1/AGRIF/agrif2model.F90 b/CROCO/croco-v1.3.1/AGRIF/agrif2model.F90 new file mode 100644 index 00000000..5209f038 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/agrif2model.F90 @@ -0,0 +1,89 @@ +#if defined key_agrif + !!---------------------------------------------------------------------- + !! NEMO/NST 3.3 , NEMO Consortium (2010) + !! $Id: agrif2model.F90 3680 2012-11-27 14:42:24Z rblod $ + !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) + !!---------------------------------------------------------------------- + SUBROUTINE Agrif2Model + !!--------------------------------------------- + !! *** ROUTINE Agrif2Model *** + !!--------------------------------------------- + END SUBROUTINE Agrif2model + + SUBROUTINE Agrif_Set_numberofcells(Agrif_Gr) + !!--------------------------------------------- + !! *** ROUTINE Agrif_Set_numberofcells *** + !!--------------------------------------------- + USE Agrif_Grids + IMPLICIT NONE + + Type(Agrif_Grid), Pointer :: Agrif_Gr + + IF ( associated(Agrif_Curgrid) )THEN +#include "SetNumberofcells.h" + ENDIF + + END SUBROUTINE Agrif_Set_numberofcells + + SUBROUTINE Agrif_Get_numberofcells(Agrif_Gr) + !!--------------------------------------------- + !! *** ROUTINE Agrif_Get_numberofcells *** + !!--------------------------------------------- + USE Agrif_Grids + IMPLICIT NONE + + Type(Agrif_Grid), Pointer :: Agrif_Gr + + if ( associated(Agrif_Curgrid) ) then +#include "GetNumberofcells.h" + endif + + END SUBROUTINE Agrif_Get_numberofcells + + SUBROUTINE Agrif_Allocationcalls(Agrif_Gr) + !!--------------------------------------------- + !! *** ROUTINE Agrif_Allocationscalls *** + !!--------------------------------------------- + USE Agrif_Grids +#include "include_use_Alloc_agrif.h" + IMPLICIT NONE + + Type(Agrif_Grid), Pointer :: Agrif_Gr + +#include "allocations_calls_agrif.h" + + END SUBROUTINE Agrif_Allocationcalls + + SUBROUTINE Agrif_probdim_modtype_def() + !!--------------------------------------------- + !! *** ROUTINE Agrif_probdim_modtype_def *** + !!--------------------------------------------- + USE Agrif_Types + IMPLICIT NONE + +#include "modtype_agrif.h" +#include "probdim_agrif.h" +#include "keys_agrif.h" + + Return + + END SUBROUTINE Agrif_probdim_modtype_def + + SUBROUTINE Agrif_clustering_def() + !!--------------------------------------------- + !! *** ROUTINE Agrif_clustering_def *** + !!--------------------------------------------- + IMPLICIT NONE + + Return + + END SUBROUTINE Agrif_clustering_def + +#else + SUBROUTINE Agrif2Model + !!--------------------------------------------- + !! *** ROUTINE Agrif2Model *** + !!--------------------------------------------- + WRITE(*,*) 'Impossible to bet here' + END SUBROUTINE Agrif2model +#endif diff --git a/CROCO/croco-v1.3.1/AGRIF/doc/Doxyfile b/CROCO/croco-v1.3.1/AGRIF/doc/Doxyfile new file mode 100644 index 00000000..42bac138 --- /dev/null +++ b/CROCO/croco-v1.3.1/AGRIF/doc/Doxyfile @@ -0,0 +1,2381 @@ +# Doxyfile 1.8.9.1 + +# This file describes the settings to be used by the documentation system +# doxygen (www.doxygen.org) for a project. +# +# All text after a double hash (##) is considered a comment and is placed in +# front of the TAG it is preceding. +# +# All text after a single hash (#) is considered a comment and will be ignored. +# The format is: +# TAG = value [value, ...] +# For lists, items can also be appended using: +# TAG += value [value, ...] +# Values that contain spaces should be placed between quotes (\" \"). + +#--------------------------------------------------------------------------- +# Project related configuration options +#--------------------------------------------------------------------------- + +# This tag specifies the encoding used for all characters in the config file +# that follow. The default is UTF-8 which is also the encoding used for all text +# before the first occurrence of this tag. Doxygen uses libiconv (or the iconv +# built into libc) for the transcoding. See http://www.gnu.org/software/libiconv +# for the list of possible encodings. +# The default value is: UTF-8. + +DOXYFILE_ENCODING = UTF-8 + +# The PROJECT_NAME tag is a single word (or a sequence of words surrounded by +# double-quotes, unless you are using Doxywizard) that should identify the +# project for which the documentation is generated. This name is used in the +# title of most generated pages and in a few other places. +# The default value is: My Project. + +PROJECT_NAME = "AGRIF - User's Guide" + +# The PROJECT_NUMBER tag can be used to enter a project or revision number. This +# could be handy for archiving the generated documentation or if some version +# control system is used. + +PROJECT_NUMBER = + +# Using the PROJECT_BRIEF tag one can provide an optional one line description +# for a project that appears at the top of each page and should give viewer a +# quick idea about the purpose of the project. Keep the description short. + +PROJECT_BRIEF = "Adaptive Grid Refinement In Fortran" + +# With the PROJECT_LOGO tag one can specify a logo or an icon that is included +# in the documentation. The maximum height of the logo should not exceed 55 +# pixels and the maximum width should not exceed 200 pixels. Doxygen will copy +# the logo to the output directory. + +PROJECT_LOGO = + +# The OUTPUT_DIRECTORY tag is used to specify the (relative or absolute) path +# into which the generated documentation will be written. If a relative path is +# entered, it will be relative to the location where doxygen was started. If +# left blank the current directory will be used. + +OUTPUT_DIRECTORY = ../UserDoc + +# If the CREATE_SUBDIRS tag is set to YES then doxygen will create 4096 sub- +# directories (in 2 levels) under the output directory of each output format and +# will distribute the generated files over these directories. Enabling this +# option can be useful when feeding doxygen a huge amount of source files, where +# putting all generated files in the same directory would otherwise causes +# performance problems for the file system. +# The default value is: NO. + +CREATE_SUBDIRS = NO + +# If the ALLOW_UNICODE_NAMES tag is set to YES, doxygen will allow non-ASCII +# characters to appear in the names of generated files. If set to NO, non-ASCII +# characters will be escaped, for example _xE3_x81_x84 will be used for Unicode +# U+3044. +# The default value is: NO. + +ALLOW_UNICODE_NAMES = NO + +# The OUTPUT_LANGUAGE tag is used to specify the language in which all +# documentation generated by doxygen is written. Doxygen will use this +# information to generate all constant output in the proper language. +# Possible values are: Afrikaans, Arabic, Armenian, Brazilian, Catalan, Chinese, +# Chinese-Traditional, Croatian, Czech, Danish, Dutch, English (United States), +# Esperanto, Farsi (Persian), Finnish, French, German, Greek, Hungarian, +# Indonesian, Italian, Japanese, Japanese-en (Japanese with English messages), +# Korean, Korean-en (Korean with English messages), Latvian, Lithuanian, +# Macedonian, Norwegian, Persian (Farsi), Polish, Portuguese, Romanian, Russian, +# Serbian, Serbian-Cyrillic, Slovak, Slovene, Spanish, Swedish, Turkish, +# Ukrainian and Vietnamese. +# The default value is: English. + +OUTPUT_LANGUAGE = English + +# If the BRIEF_MEMBER_DESC tag is set to YES, doxygen will include brief member +# descriptions after the members that are listed in the file and class +# documentation (similar to Javadoc). Set to NO to disable this. +# The default value is: YES. + +BRIEF_MEMBER_DESC = YES + +# If the REPEAT_BRIEF tag is set to YES, doxygen will prepend the brief +# description of a member or function before the detailed description +# +# Note: If both HIDE_UNDOC_MEMBERS and BRIEF_MEMBER_DESC are set to NO, the +# brief descriptions will be completely suppressed. +# The default value is: YES. + +REPEAT_BRIEF = YES + +# This tag implements a quasi-intelligent brief description abbreviator that is +# used to form the text in various listings. Each string in this list, if found +# as the leading text of the brief description, will be stripped from the text +# and the result, after processing the whole list, is used as the annotated +# text. Otherwise, the brief description is used as-is. If left blank, the +# following values are used ($name is automatically replaced with the name of +# the entity):The $name class, The $name widget, The $name file, is, provides, +# specifies, contains, represents, a, an and the. + +ABBREVIATE_BRIEF = + +# If the ALWAYS_DETAILED_SEC and REPEAT_BRIEF tags are both set to YES then +# doxygen will generate a detailed section even if there is only a brief +# description. +# The default value is: NO. + +ALWAYS_DETAILED_SEC = NO + +# If the INLINE_INHERITED_MEMB tag is set to YES, doxygen will show all +# inherited members of a class in the documentation of that class as if those +# members were ordinary class members. Constructors, destructors and assignment +# operators of the base classes will not be shown. +# The default value is: NO. + +INLINE_INHERITED_MEMB = NO + +# If the FULL_PATH_NAMES tag is set to YES, doxygen will prepend the full path +# before files name in the file list and in the header files. If set to NO the +# shortest path that makes the file name unique will be used +# The default value is: YES. + +FULL_PATH_NAMES = NO + +# The STRIP_FROM_PATH tag can be used to strip a user-defined part of the path. +# Stripping is only done if one of the specified strings matches the left-hand +# part of the path. The tag can be used to show relative paths in the file list. +# If left blank the directory from which doxygen is run is used as the path to +# strip. +# +# Note that you can specify absolute paths here, but also relative paths, which +# will be relative from the directory where doxygen is started. +# This tag requires that the tag FULL_PATH_NAMES is set to YES. + +STRIP_FROM_PATH = + +# The STRIP_FROM_INC_PATH tag can be used to strip a user-defined part of the +# path mentioned in the documentation of a class, which tells the reader which +# header file to include in order to use a class. If left blank only the name of +# the header file containing the class definition is used. Otherwise one should +# specify the list of include paths that are normally passed to the compiler +# using the -I flag. + +STRIP_FROM_INC_PATH = + +# If the SHORT_NAMES tag is set to YES, doxygen will generate much shorter (but +# less readable) file names. This can be useful is your file systems doesn't +# support long names like on DOS, Mac, or CD-ROM. +# The default value is: NO. + +SHORT_NAMES = NO + +# If the JAVADOC_AUTOBRIEF tag is set to YES then doxygen will interpret the +# first line (until the first dot) of a Javadoc-style comment as the brief +# description. If set to NO, the Javadoc-style will behave just like regular Qt- +# style comments (thus requiring an explicit @brief command for a brief +# description.) +# The default value is: NO. + +JAVADOC_AUTOBRIEF = NO + +# If the QT_AUTOBRIEF tag is set to YES then doxygen will interpret the first +# line (until the first dot) of a Qt-style comment as the brief description. If +# set to NO, the Qt-style will behave just like regular Qt-style comments (thus +# requiring an explicit \brief command for a brief description.) +# The default value is: NO. + +QT_AUTOBRIEF = NO + +# The MULTILINE_CPP_IS_BRIEF tag can be set to YES to make doxygen treat a +# multi-line C++ special comment block (i.e. a block of //! or /// comments) as +# a brief description. This used to be the default behavior. The new default is +# to treat a multi-line C++ comment block as a detailed description. Set this +# tag to YES if you prefer the old behavior instead. +# +# Note that setting this tag to YES also means that rational rose comments are +# not recognized any more. +# The default value is: NO. + +MULTILINE_CPP_IS_BRIEF = NO + +# If the INHERIT_DOCS tag is set to YES then an undocumented member inherits the +# documentation from any documented member that it re-implements. +# The default value is: YES. + +INHERIT_DOCS = YES + +# If the SEPARATE_MEMBER_PAGES tag is set to YES then doxygen will produce a new +# page for each member. If set to NO, the documentation of a member will be part +# of the file/class/namespace that contains it. +# The default value is: NO. + +SEPARATE_MEMBER_PAGES = NO + +# The TAB_SIZE tag can be used to set the number of spaces in a tab. Doxygen +# uses this value to replace tabs by spaces in code fragments. +# Minimum value: 1, maximum value: 16, default value: 4. + +TAB_SIZE = 4 + +# This tag can be used to specify a number of aliases that act as commands in +# the documentation. An alias has the form: +# name=value +# For example adding +# "sideeffect=@par Side Effects:\n" +# will allow you to put the command \sideeffect (or @sideeffect) in the +# documentation, which will result in a user-defined paragraph with heading +# "Side Effects:". You can put \n's in the value part of an alias to insert +# newlines. + +ALIASES = + +# This tag can be used to specify a number of word-keyword mappings (TCL only). +# A mapping has the form "name=value". For example adding "class=itcl::class" +# will allow you to use the command class in the itcl::class meaning. + +TCL_SUBST = + +# Set the OPTIMIZE_OUTPUT_FOR_C tag to YES if your project consists of C sources +# only. Doxygen will then generate output that is more tailored for C. For +# instance, some of the names that are used will be different. The list of all +# members will be omitted, etc. +# The default value is: NO. + +OPTIMIZE_OUTPUT_FOR_C = NO + +# Set the OPTIMIZE_OUTPUT_JAVA tag to YES if your project consists of Java or +# Python sources only. Doxygen will then generate output that is more tailored +# for that language. For instance, namespaces will be presented as packages, +# qualified scopes will look different, etc. +# The default value is: NO. + +OPTIMIZE_OUTPUT_JAVA = NO + +# Set the OPTIMIZE_FOR_FORTRAN tag to YES if your project consists of Fortran +# sources. Doxygen will then generate output that is tailored for Fortran. +# The default value is: NO. + +OPTIMIZE_FOR_FORTRAN = YES + +# Set the OPTIMIZE_OUTPUT_VHDL tag to YES if your project consists of VHDL +# sources. Doxygen will then generate output that is tailored for VHDL. +# The default value is: NO. + +OPTIMIZE_OUTPUT_VHDL = NO + +# Doxygen selects the parser to use depending on the extension of the files it +# parses. With this tag you can assign which parser to use for a given +# extension. Doxygen has a built-in mapping, but you can override or extend it +# using this tag. The format is ext=language, where ext is a file extension, and +# language is one of the parsers supported by doxygen: IDL, Java, Javascript, +# C#, C, C++, D, PHP, Objective-C, Python, Fortran (fixed format Fortran: +# FortranFixed, free formatted Fortran: FortranFree, unknown formatted Fortran: +# Fortran. In the later case the parser tries to guess whether the code is fixed +# or free formatted code, this is the default for Fortran type files), VHDL. For +# instance to make doxygen treat .inc files as Fortran files (default is PHP), +# and .f files as C (default is Fortran), use: inc=Fortran f=C. +# +# Note: For files without extension you can use no_extension as a placeholder. +# +# Note that for custom extensions you also need to set FILE_PATTERNS otherwise +# the files are not read by doxygen. + +EXTENSION_MAPPING = + +# If the MARKDOWN_SUPPORT tag is enabled then doxygen pre-processes all comments +# according to the Markdown format, which allows for more readable +# documentation. See http://daringfireball.net/projects/markdown/ for details. +# The output of markdown processing is further processed by doxygen, so you can +# mix doxygen, HTML, and XML commands with Markdown formatting. Disable only in +# case of backward compatibilities issues. +# The default value is: YES. + +MARKDOWN_SUPPORT = YES + +# When enabled doxygen tries to link words that correspond to documented +# classes, or namespaces to their corresponding documentation. Such a link can +# be prevented in individual cases by putting a % sign in front of the word or +# globally by setting AUTOLINK_SUPPORT to NO. +# The default value is: YES. + +AUTOLINK_SUPPORT = YES + +# If you use STL classes (i.e. std::string, std::vector, etc.) but do not want +# to include (a tag file for) the STL sources as input, then you should set this +# tag to YES in order to let doxygen match functions declarations and +# definitions whose arguments contain STL classes (e.g. func(std::string); +# versus func(std::string) {}). This also make the inheritance and collaboration +# diagrams that involve STL classes more complete and accurate. +# The default value is: NO. + +BUILTIN_STL_SUPPORT = NO + +# If you use Microsoft's C++/CLI language, you should set this option to YES to +# enable parsing support. +# The default value is: NO. + +CPP_CLI_SUPPORT = NO + +# Set the SIP_SUPPORT tag to YES if your project consists of sip (see: +# http://www.riverbankcomputing.co.uk/software/sip/intro) sources only. Doxygen +# will parse them like normal C++ but will assume all classes use public instead +# of private inheritance when no explicit protection keyword is present. +# The default value is: NO. + +SIP_SUPPORT = NO + +# For Microsoft's IDL there are propget and propput attributes to indicate +# getter and setter methods for a property. Setting this option to YES will make +# doxygen to replace the get and set methods by a property in the documentation. +# This will only work if the methods are indeed getting or setting a simple +# type. If this is not the case, or you want to show the methods anyway, you +# should set this option to NO. +# The default value is: YES. + +IDL_PROPERTY_SUPPORT = YES + +# If member grouping is used in the documentation and the DISTRIBUTE_GROUP_DOC +# tag is set to YES then doxygen will reuse the documentation of the first +# member in the group (if any) for the other members of the group. By default +# all members of a group must be documented explicitly. +# The default value is: NO. + +DISTRIBUTE_GROUP_DOC = NO + +# Set the SUBGROUPING tag to YES to allow class member groups of the same type +# (for instance a group of public functions) to be put as a subgroup of that +# type (e.g. under the Public Functions section). Set it to NO to prevent +# subgrouping. Alternatively, this can be done per class using the +# \nosubgrouping command. +# The default value is: YES. + +SUBGROUPING = YES + +# When the INLINE_GROUPED_CLASSES tag is set to YES, classes, structs and unions +# are shown inside the group in which they are included (e.g. using \ingroup) +# instead of on a separate page (for HTML and Man pages) or section (for LaTeX +# and RTF). +# +# Note that this feature does not work in combination with +# SEPARATE_MEMBER_PAGES. +# The default value is: NO. + +INLINE_GROUPED_CLASSES = NO + +# When the INLINE_SIMPLE_STRUCTS tag is set to YES, structs, classes, and unions +# with only public data fields or simple typedef fields will be shown inline in +# the documentation of the scope in which they are defined (i.e. file, +# namespace, or group documentation), provided this scope is documented. If set +# to NO, structs, classes, and unions are shown on a separate page (for HTML and +# Man pages) or section (for LaTeX and RTF). +# The default value is: NO. + +INLINE_SIMPLE_STRUCTS = NO + +# When TYPEDEF_HIDES_STRUCT tag is enabled, a typedef of a struct, union, or +# enum is documented as struct, union, or enum with the name of the typedef. So +# typedef struct TypeS {} TypeT, will appear in the documentation as a struct +# with name TypeT. When disabled the typedef will appear as a member of a file, +# namespace, or class. And the struct will be named TypeS. This can typically be +# useful for C code in case the coding convention dictates that all compound +# types are typedef'ed and only the typedef is referenced, never the tag name. +# The default value is: NO. + +TYPEDEF_HIDES_STRUCT = NO + +# The size of the symbol lookup cache can be set using LOOKUP_CACHE_SIZE. This +# cache is used to resolve symbols given their name and scope. Since this can be +# an expensive process and often the same symbol appears multiple times in the +# code, doxygen keeps a cache of pre-resolved symbols. If the cache is too small +# doxygen will become slower. If the cache is too large, memory is wasted. The +# cache size is given by this formula: 2^(16+LOOKUP_CACHE_SIZE). The valid range +# is 0..9, the default is 0, corresponding to a cache size of 2^16=65536 +# symbols. At the end of a run doxygen will report the cache usage and suggest +# the optimal cache size from a speed point of view. +# Minimum value: 0, maximum value: 9, default value: 0. + +LOOKUP_CACHE_SIZE = 0 + +#--------------------------------------------------------------------------- +# Build related configuration options +#--------------------------------------------------------------------------- + +# If the EXTRACT_ALL tag is set to YES, doxygen will assume all entities in +# documentation are documented, even if no documentation was available. Private +# class members and static file members will be hidden unless the +# EXTRACT_PRIVATE respectively EXTRACT_STATIC tags are set to YES. +# Note: This will also disable the warnings about undocumented members that are +# normally produced when WARNINGS is set to YES. +# The default value is: NO. + +EXTRACT_ALL = YES + +# If the EXTRACT_PRIVATE tag is set to YES, all private members of a class will +# be included in the documentation. +# The default value is: NO. + +EXTRACT_PRIVATE = YES + +# If the EXTRACT_PACKAGE tag is set to YES, all members with package or internal +# scope will be included in the documentation. +# The default value is: NO. + +EXTRACT_PACKAGE = YES + +# If the EXTRACT_STATIC tag is set to YES, all static members of a file will be +# included in the documentation. +# The default value is: NO. + +EXTRACT_STATIC = YES + +# If the EXTRACT_LOCAL_CLASSES tag is set to YES, classes (and structs) defined +# locally in source files will be included in the documentation. If set to NO, +# only classes defined in header files are included. Does not have any effect +# for Java sources. +# The default value is: YES. + +EXTRACT_LOCAL_CLASSES = YES + +# This flag is only useful for Objective-C code. If set to YES, local methods, +# which are defined in the implementation section but not in the interface are +# included in the documentation. If set to NO, only methods in the interface are +# included. +# The default value is: NO. + +EXTRACT_LOCAL_METHODS = NO + +# If this flag is set to YES, the members of anonymous namespaces will be +# extracted and appear in the documentation as a namespace called +# 'anonymous_namespace{file}', where file will be replaced with the base name of +# the file that contains the anonymous namespace. By default anonymous namespace +# are hidden. +# The default value is: NO. + +EXTRACT_ANON_NSPACES = YES + +# If the HIDE_UNDOC_MEMBERS tag is set to YES, doxygen will hide all +# undocumented members inside documented classes or files. If set to NO these +# members will be included in the various overviews, but no documentation +# section is generated. This option has no effect if EXTRACT_ALL is enabled. +# The default value is: NO. + +HIDE_UNDOC_MEMBERS = NO + +# If the HIDE_UNDOC_CLASSES tag is set to YES, doxygen will hide all +# undocumented classes that are normally visible in the class hierarchy. If set +# to NO, these classes will be included in the various overviews. This option +# has no effect if EXTRACT_ALL is enabled. +# The default value is: NO. + +HIDE_UNDOC_CLASSES = NO + +# If the HIDE_FRIEND_COMPOUNDS tag is set to YES, doxygen will hide all friend +# (class|struct|union) declarations. If set to NO, these declarations will be +# included in the documentation. +# The default value is: NO. + +HIDE_FRIEND_COMPOUNDS = NO + +# If the HIDE_IN_BODY_DOCS tag is set to YES, doxygen will hide any +# documentation blocks found inside the body of a function. If set to NO, these +# blocks will be appended to the function's detailed documentation block. +# The default value is: NO. + +HIDE_IN_BODY_DOCS = NO + +# The INTERNAL_DOCS tag determines if documentation that is typed after a +# \internal command is included. If the tag is set to NO then the documentation +# will be excluded. Set it to YES to include the internal documentation. +# The default value is: NO. + +INTERNAL_DOCS = YES + +# If the CASE_SENSE_NAMES tag is set to NO then doxygen will only generate file +# names in lower-case letters. If set to YES, upper-case letters are also +# allowed. This is useful if you have classes or files whose names only differ +# in case and if your file system supports case sensitive file names. Windows +# and Mac users are advised to set this option to NO. +# The default value is: system dependent. + +CASE_SENSE_NAMES = NO + +# If the HIDE_SCOPE_NAMES tag is set to NO then doxygen will show members with +# their full class and namespace scopes in the documentation. If set to YES, the +# scope will be hidden. +# The default value is: NO. + +HIDE_SCOPE_NAMES = YES + +# If the HIDE_COMPOUND_REFERENCE tag is set to NO (default) then doxygen will +# append additional text to a page's title, such as Class Reference. If set to +# YES the compound reference will be hidden. +# The default value is: NO. + +HIDE_COMPOUND_REFERENCE= NO + +# If the SHOW_INCLUDE_FILES tag is set to YES then doxygen will put a list of +# the files that are included by a file in the documentation of that file. +# The default value is: YES. + +SHOW_INCLUDE_FILES = YES + +# If the SHOW_GROUPED_MEMB_INC tag is set to YES then Doxygen will add for each +# grouped member an include statement to the documentation, telling the reader +# which file to include in order to use the member. +# The default value is: NO. + +SHOW_GROUPED_MEMB_INC = NO + +# If the FORCE_LOCAL_INCLUDES tag is set to YES then doxygen will list include +# files with double quotes in the documentation rather than with sharp brackets. +# The default value is: NO. + +FORCE_LOCAL_INCLUDES = NO + +# If the INLINE_INFO tag is set to YES then a tag [inline] is inserted in the +# documentation for inline members. +# The default value is: YES. + +INLINE_INFO = YES + +# If the SORT_MEMBER_DOCS tag is set to YES then doxygen will sort the +# (detailed) documentation of file and class members alphabetically by member +# name. If set to NO, the members will appear in declaration order. +# The default value is: YES. + +SORT_MEMBER_DOCS = YES + +# If the SORT_BRIEF_DOCS tag is set to YES then doxygen will sort the brief +# descriptions of file, namespace and class members alphabetically by member +# name. If set to NO, the members will appear in declaration order. Note that +# this will also influence the order of the classes in the class list. +# The default value is: NO. + +SORT_BRIEF_DOCS = NO + +# If the SORT_MEMBERS_CTORS_1ST tag is set to YES then doxygen will sort the +# (brief and detailed) documentation of class members so that constructors and +# destructors are listed first. If set to NO the constructors will appear in the +# respective orders defined by SORT_BRIEF_DOCS and SORT_MEMBER_DOCS. +# Note: If SORT_BRIEF_DOCS is set to NO this option is ignored for sorting brief +# member documentation. +# Note: If SORT_MEMBER_DOCS is set to NO this option is ignored for sorting +# detailed member documentation. +# The default value is: NO. + +SORT_MEMBERS_CTORS_1ST = NO + +# If the SORT_GROUP_NAMES tag is set to YES then doxygen will sort the hierarchy +# of group names into alphabetical order. If set to NO the group names will +# appear in their defined order. +# The default value is: NO. + +SORT_GROUP_NAMES = YES + +# If the SORT_BY_SCOPE_NAME tag is set to YES, the class list will be sorted by +# fully-qualified names, including namespaces. If set to NO, the class list will +# be sorted only by class name, not including the namespace part. +# Note: This option is not very useful if HIDE_SCOPE_NAMES is set to YES. +# Note: This option applies only to the class list, not to the alphabetical +# list. +# The default value is: NO. + +SORT_BY_SCOPE_NAME = YES + +# If the STRICT_PROTO_MATCHING option is enabled and doxygen fails to do proper +# type resolution of all parameters of a function it will reject a match between +# the prototype and the implementation of a member function even if there is +# only one candidate or it is obvious which candidate to choose by doing a +# simple string match. By disabling STRICT_PROTO_MATCHING doxygen will still +# accept a match between prototype and implementation in such cases. +# The default value is: NO. + +STRICT_PROTO_MATCHING = NO + +# The GENERATE_TODOLIST tag can be used to enable (YES) or disable (NO) the todo +# list. This list is created by putting \todo commands in the documentation. +# The default value is: YES. + +GENERATE_TODOLIST = YES + +# The GENERATE_TESTLIST tag can be used to enable (YES) or disable (NO) the test +# list. This list is created by putting \test commands in the documentation. +# The default value is: YES. + +GENERATE_TESTLIST = YES + +# The GENERATE_BUGLIST tag can be used to enable (YES) or disable (NO) the bug +# list. This list is created by putting \bug commands in the documentation. +# The default value is: YES. + +GENERATE_BUGLIST = YES + +# The GENERATE_DEPRECATEDLIST tag can be used to enable (YES) or disable (NO) +# the deprecated list. This list is created by putting \deprecated commands in +# the documentation. +# The default value is: YES. + +GENERATE_DEPRECATEDLIST= YES + +# The ENABLED_SECTIONS tag can be used to enable conditional documentation +# sections, marked by \if ... \endif and \cond +# ... \endcond blocks. + +ENABLED_SECTIONS = + +# The MAX_INITIALIZER_LINES tag determines the maximum number of lines that the +# initial value of a variable or macro / define can have for it to appear in the +# documentation. If the initializer consists of more lines than specified here +# it will be hidden. Use a value of 0 to hide initializers completely. The +# appearance of the value of individual variables and macros / defines can be +# controlled using \showinitializer or \hideinitializer command in the +# documentation regardless of this setting. +# Minimum value: 0, maximum value: 10000, default value: 30. + +MAX_INITIALIZER_LINES = 30 + +# Set the SHOW_USED_FILES tag to NO to disable the list of files generated at +# the bottom of the documentation of classes and structs. If set to YES, the +# list will mention the files that were used to generate the documentation. +# The default value is: YES. + +SHOW_USED_FILES = YES + +# Set the SHOW_FILES tag to NO to disable the generation of the Files page. This +# will remove the Files entry from the Quick Index and from the Folder Tree View +# (if specified). +# The default value is: YES. + +SHOW_FILES = YES + +# Set the SHOW_NAMESPACES tag to NO to disable the generation of the Namespaces +# page. This will remove the Namespaces entry from the Quick Index and from the +# Folder Tree View (if specified). +# The default value is: YES. + +SHOW_NAMESPACES = YES + +# The FILE_VERSION_FILTER tag can be used to specify a program or script that +# doxygen should invoke to get the current version for each file (typically from +# the version control system). Doxygen will invoke the program by executing (via +# popen()) the command command input-file, where command is the value of the +# FILE_VERSION_FILTER tag, and input-file is the name of an input file provided +# by doxygen. Whatever the program writes to standard output is used as the file +# version. For an example see the documentation. + +FILE_VERSION_FILTER = + +# The LAYOUT_FILE tag can be used to specify a layout file which will be parsed +# by doxygen. The layout file controls the global structure of the generated +# output files in an output format independent way. To create the layout file +# that represents doxygen's defaults, run doxygen with the -l option. You can +# optionally specify a file name after the option, if omitted DoxygenLayout.xml +# will be used as the name of the layout file. +# +# Note that if you run doxygen from a directory containing a file called +# DoxygenLayout.xml, doxygen will parse it automatically even if the LAYOUT_FILE +# tag is left empty. + +LAYOUT_FILE = + +# The CITE_BIB_FILES tag can be used to specify one or more bib files containing +# the reference definitions. This must be a list of .bib files. The .bib +# extension is automatically appended if omitted. This requires the bibtex tool +# to be installed. See also http://en.wikipedia.org/wiki/BibTeX for more info. +# For LaTeX the style of the bibliography can be controlled using +# LATEX_BIB_STYLE. To use this feature you need bibtex and perl available in the +# search path. See also \cite for info how to create references. + +CITE_BIB_FILES = + +#--------------------------------------------------------------------------- +# Configuration options related to warning and progress messages +#--------------------------------------------------------------------------- + +# The QUIET tag can be used to turn on/off the messages that are generated to +# standard output by doxygen. If QUIET is set to YES this implies that the +# messages are off. +# The default value is: NO. + +QUIET = NO + +# The WARNINGS tag can be used to turn on/off the warning messages that are +# generated to standard error (stderr) by doxygen. If WARNINGS is set to YES +# this implies that the warnings are on. +# +# Tip: Turn warnings on while writing the documentation. +# The default value is: YES. + +WARNINGS = YES + +# If the WARN_IF_UNDOCUMENTED tag is set to YES then doxygen will generate +# warnings for undocumented members. If EXTRACT_ALL is set to YES then this flag +# will automatically be disabled. +# The default value is: YES. + +WARN_IF_UNDOCUMENTED = YES + +# If the WARN_IF_DOC_ERROR tag is set to YES, doxygen will generate warnings for +# potential errors in the documentation, such as not documenting some parameters +# in a documented function, or documenting parameters that don't exist or using +# markup commands wrongly. +# The default value is: YES. + +WARN_IF_DOC_ERROR = YES + +# This WARN_NO_PARAMDOC option can be enabled to get warnings for functions that +# are documented, but have no documentation for their parameters or return +# value. If set to NO, doxygen will only warn about wrong or incomplete +# parameter documentation, but not about the absence of documentation. +# The default value is: NO. + +WARN_NO_PARAMDOC = NO + +# The WARN_FORMAT tag determines the format of the warning messages that doxygen +# can produce. The string should contain the $file, $line, and $text tags, which +# will be replaced by the file and line number from which the warning originated +# and the warning text. Optionally the format may contain $version, which will +# be replaced by the version of the file (if it could be obtained via +# FILE_VERSION_FILTER) +# The default value is: $file:$line: $text. + +WARN_FORMAT = "$file:$line: $text" + +# The WARN_LOGFILE tag can be used to specify a file to which warning and error +# messages should be written. If left blank the output is written to standard +# error (stderr). + +WARN_LOGFILE = + +#--------------------------------------------------------------------------- +# Configuration options related to the input files +#--------------------------------------------------------------------------- + +# The INPUT tag is used to specify the files and/or directories that contain +# documented source files. You may enter file names like myfile.cpp or +# directories like /usr/src/myproject. Separate the files or directories with +# spaces. +# Note: If this tag is empty the current directory is searched. + +INPUT = ../AGRIF_FILES + +# This tag can be used to specify the character encoding of the source files +# that doxygen parses. Internally doxygen uses the UTF-8 encoding. Doxygen uses +# libiconv (or the iconv built into libc) for the transcoding. See the libiconv +# documentation (see: http://www.gnu.org/software/libiconv) for the list of +# possible encodings. +# The default value is: UTF-8. + +INPUT_ENCODING = UTF-8 + +# If the value of the INPUT tag contains directories, you can use the +# FILE_PATTERNS tag to specify one or more wildcard patterns (like *.cpp and +# *.h) to filter out the source-files in the directories. If left blank the +# following patterns are tested:*.c, *.cc, *.cxx, *.cpp, *.c++, *.java, *.ii, +# *.ixx, *.ipp, *.i++, *.inl, *.idl, *.ddl, *.odl, *.h, *.hh, *.hxx, *.hpp, +# *.h++, *.cs, *.d, *.php, *.php4, *.php5, *.phtml, *.inc, *.m, *.markdown, +# *.md, *.mm, *.dox, *.py, *.f90, *.f, *.for, *.tcl, *.vhd, *.vhdl, *.ucf, +# *.qsf, *.as and *.js. + +FILE_PATTERNS = *.F90 + +# The RECURSIVE tag can be used to specify whether or not subdirectories should +# be searched for input files as well. +# The default value is: NO. + +RECURSIVE = YES + +# The EXCLUDE tag can be used to specify files and/or directories that should be +# excluded from the INPUT source files. This way you can easily exclude a +# subdirectory from a directory tree whose root is specified with the INPUT tag. +# +# Note that relative paths are relative to the directory from which doxygen is +# run. + +EXCLUDE = + +# The EXCLUDE_SYMLINKS tag can be used to select whether or not files or +# directories that are symbolic links (a Unix file system feature) are excluded +# from the input. +# The default value is: NO. + +EXCLUDE_SYMLINKS = NO + +# If the value of the INPUT tag contains directories, you can use the +# EXCLUDE_PATTERNS tag to specify one or more wildcard patterns to exclude +# certain files from those directories. +# +# Note that the wildcards are matched against the file with absolute path, so to +# exclude all test directories for example use the pattern */test/* + +EXCLUDE_PATTERNS = + +# The EXCLUDE_SYMBOLS tag can be used to specify one or more symbol names +# (namespaces, classes, functions, etc.) that should be excluded from the +# output. The symbol name can be a fully qualified name, a word, or if the +# wildcard * is used, a substring. Examples: ANamespace, AClass, +# AClass::ANamespace, ANamespace::*Test +# +# Note that the wildcards are matched against the file with absolute path, so to +# exclude all test directories use the pattern */test/* + +EXCLUDE_SYMBOLS = + +# The EXAMPLE_PATH tag can be used to specify one or more files or directories +# that contain example code fragments that are included (see the \include +# command). + +EXAMPLE_PATH = + +# If the value of the EXAMPLE_PATH tag contains directories, you can use the +# EXAMPLE_PATTERNS tag to specify one or more wildcard pattern (like *.cpp and +# *.h) to filter out the source-files in the directories. If left blank all +# files are included. + +EXAMPLE_PATTERNS = + +# If the EXAMPLE_RECURSIVE tag is set to YES then subdirectories will be +# searched for input files to be used with the \include or \dontinclude commands +# irrespective of the value of the RECURSIVE tag. +# The default value is: NO. + +EXAMPLE_RECURSIVE = NO + +# The IMAGE_PATH tag can be used to specify one or more files or directories +# that contain images that are to be included in the documentation (see the +# \image command). + +IMAGE_PATH = + +# The INPUT_FILTER tag can be used to specify a program that doxygen should +# invoke to filter for each input file. Doxygen will invoke the filter program +# by executing (via popen()) the command: +# +# +# +# where is the value of the INPUT_FILTER tag, and is the +# name of an input file. Doxygen will then use the output that the filter +# program writes to standard output. If FILTER_PATTERNS is specified, this tag +# will be ignored. +# +# Note that the filter must not add or remove lines; it is applied before the +# code is scanned, but not when the output code is generated. If lines are added +# or removed, the anchors will not be placed correctly. + +INPUT_FILTER = + +# The FILTER_PATTERNS tag can be used to specify filters on a per file pattern +# basis. Doxygen will compare the file name with each pattern and apply the +# filter if there is a match. The filters are a list of the form: pattern=filter +# (like *.cpp=my_cpp_filter). See INPUT_FILTER for further information on how +# filters are used. If the FILTER_PATTERNS tag is empty or if none of the +# patterns match the file name, INPUT_FILTER is applied. + +FILTER_PATTERNS = + +# If the FILTER_SOURCE_FILES tag is set to YES, the input filter (if set using +# INPUT_FILTER) will also be used to filter the input files that are used for +# producing the source files to browse (i.e. when SOURCE_BROWSER is set to YES). +# The default value is: NO. + +FILTER_SOURCE_FILES = NO + +# The FILTER_SOURCE_PATTERNS tag can be used to specify source filters per file +# pattern. A pattern will override the setting for FILTER_PATTERN (if any) and +# it is also possible to disable source filtering for a specific pattern using +# *.ext= (so without naming a filter). +# This tag requires that the tag FILTER_SOURCE_FILES is set to YES. + +FILTER_SOURCE_PATTERNS = + +# If the USE_MDFILE_AS_MAINPAGE tag refers to the name of a markdown file that +# is part of the input, its contents will be placed on the main page +# (index.html). This can be useful if you have a project on for instance GitHub +# and want to reuse the introduction page also for the doxygen output. + +USE_MDFILE_AS_MAINPAGE = + +#--------------------------------------------------------------------------- +# Configuration options related to source browsing +#--------------------------------------------------------------------------- + +# If the SOURCE_BROWSER tag is set to YES then a list of source files will be +# generated. Documented entities will be cross-referenced with these sources. +# +# Note: To get rid of all source code in the generated output, make sure that +# also VERBATIM_HEADERS is set to NO. +# The default value is: NO. + +SOURCE_BROWSER = YES + +# Setting the INLINE_SOURCES tag to YES will include the body of functions, +# classes and enums directly into the documentation. +# The default value is: NO. + +INLINE_SOURCES = NO + +# Setting the STRIP_CODE_COMMENTS tag to YES will instruct doxygen to hide any +# special comment blocks from generated source code fragments. Normal C, C++ and +# Fortran comments will always remain visible. +# The default value is: YES. + +STRIP_CODE_COMMENTS = NO + +# If the REFERENCED_BY_RELATION tag is set to YES then for each documented +# function all documented functions referencing it will be listed. +# The default value is: NO. + +REFERENCED_BY_RELATION = YES + +# If the REFERENCES_RELATION tag is set to YES then for each documented function +# all documented entities called/used by that function will be listed. +# The default value is: NO. + +REFERENCES_RELATION = YES + +# If the REFERENCES_LINK_SOURCE tag is set to YES and SOURCE_BROWSER tag is set +# to YES then the hyperlinks from functions in REFERENCES_RELATION and +# REFERENCED_BY_RELATION lists will link to the source code. Otherwise they will +# link to the documentation. +# The default value is: YES. + +REFERENCES_LINK_SOURCE = YES + +# If SOURCE_TOOLTIPS is enabled (the default) then hovering a hyperlink in the +# source code will show a tooltip with additional information such as prototype, +# brief description and links to the definition and documentation. Since this +# will make the HTML file larger and loading of large files a bit slower, you +# can opt to disable this feature. +# The default value is: YES. +# This tag requires that the tag SOURCE_BROWSER is set to YES. + +SOURCE_TOOLTIPS = YES + +# If the USE_HTAGS tag is set to YES then the references to source code will +# point to the HTML generated by the htags(1) tool instead of doxygen built-in +# source browser. The htags tool is part of GNU's global source tagging system +# (see http://www.gnu.org/software/global/global.html). You will need version +# 4.8.6 or higher. +# +# To use it do the following: +# - Install the latest version of global +# - Enable SOURCE_BROWSER and USE_HTAGS in the config file +# - Make sure the INPUT points to the root of the source tree +# - Run doxygen as normal +# +# Doxygen will invoke htags (and that will in turn invoke gtags), so these +# tools must be available from the command line (i.e. in the search path). +# +# The result: instead of the source browser generated by doxygen, the links to +# source code will now point to the output of htags. +# The default value is: NO. +# This tag requires that the tag SOURCE_BROWSER is set to YES. + +USE_HTAGS = NO + +# If the VERBATIM_HEADERS tag is set the YES then doxygen will generate a +# verbatim copy of the header file for each class for which an include is +# specified. Set to NO to disable this. +# See also: Section \class. +# The default value is: YES. + +VERBATIM_HEADERS = YES + +# If the CLANG_ASSISTED_PARSING tag is set to YES then doxygen will use the +# clang parser (see: http://clang.llvm.org/) for more accurate parsing at the +# cost of reduced performance. This can be particularly helpful with template +# rich C++ code for which doxygen's built-in parser lacks the necessary type +# information. +# Note: The availability of this option depends on whether or not doxygen was +# compiled with the --with-libclang option. +# The default value is: NO. + +CLANG_ASSISTED_PARSING = NO + +# If clang assisted parsing is enabled you can provide the compiler with command +# line options that you would normally use when invoking the compiler. Note that +# the include paths will already be set by doxygen for the files and directories +# specified with INPUT and INCLUDE_PATH. +# This tag requires that the tag CLANG_ASSISTED_PARSING is set to YES. + +CLANG_OPTIONS = + +#--------------------------------------------------------------------------- +# Configuration options related to the alphabetical class index +#--------------------------------------------------------------------------- + +# If the ALPHABETICAL_INDEX tag is set to YES, an alphabetical index of all +# compounds will be generated. Enable this if the project contains a lot of +# classes, structs, unions or interfaces. +# The default value is: YES. + +ALPHABETICAL_INDEX = YES + +# The COLS_IN_ALPHA_INDEX tag can be used to specify the number of columns in +# which the alphabetical index list will be split. +# Minimum value: 1, maximum value: 20, default value: 5. +# This tag requires that the tag ALPHABETICAL_INDEX is set to YES. + +COLS_IN_ALPHA_INDEX = 5 + +# In case all classes in a project start with a common prefix, all classes will +# be put under the same header in the alphabetical index. The IGNORE_PREFIX tag +# can be used to specify a prefix (or a list of prefixes) that should be ignored +# while generating the index headers. +# This tag requires that the tag ALPHABETICAL_INDEX is set to YES. + +IGNORE_PREFIX = + +#--------------------------------------------------------------------------- +# Configuration options related to the HTML output +#--------------------------------------------------------------------------- + +# If the GENERATE_HTML tag is set to YES, doxygen will generate HTML output +# The default value is: YES. + +GENERATE_HTML = NO + +# The HTML_OUTPUT tag is used to specify where the HTML docs will be put. If a +# relative path is entered the value of OUTPUT_DIRECTORY will be put in front of +# it. +# The default directory is: html. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_OUTPUT = html + +# The HTML_FILE_EXTENSION tag can be used to specify the file extension for each +# generated HTML page (for example: .htm, .php, .asp). +# The default value is: .html. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_FILE_EXTENSION = .html + +# The HTML_HEADER tag can be used to specify a user-defined HTML header file for +# each generated HTML page. If the tag is left blank doxygen will generate a +# standard header. +# +# To get valid HTML the header file that includes any scripts and style sheets +# that doxygen needs, which is dependent on the configuration options used (e.g. +# the setting GENERATE_TREEVIEW). It is highly recommended to start with a +# default header using +# doxygen -w html new_header.html new_footer.html new_stylesheet.css +# YourConfigFile +# and then modify the file new_header.html. See also section "Doxygen usage" +# for information on how to generate the default header that doxygen normally +# uses. +# Note: The header is subject to change so you typically have to regenerate the +# default header when upgrading to a newer version of doxygen. For a description +# of the possible markers and block names see the documentation. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_HEADER = + +# The HTML_FOOTER tag can be used to specify a user-defined HTML footer for each +# generated HTML page. If the tag is left blank doxygen will generate a standard +# footer. See HTML_HEADER for more information on how to generate a default +# footer and what special commands can be used inside the footer. See also +# section "Doxygen usage" for information on how to generate the default footer +# that doxygen normally uses. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_FOOTER = + +# The HTML_STYLESHEET tag can be used to specify a user-defined cascading style +# sheet that is used by each HTML page. It can be used to fine-tune the look of +# the HTML output. If left blank doxygen will generate a default style sheet. +# See also section "Doxygen usage" for information on how to generate the style +# sheet that doxygen normally uses. +# Note: It is recommended to use HTML_EXTRA_STYLESHEET instead of this tag, as +# it is more robust and this tag (HTML_STYLESHEET) will in the future become +# obsolete. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_STYLESHEET = + +# The HTML_EXTRA_STYLESHEET tag can be used to specify additional user-defined +# cascading style sheets that are included after the standard style sheets +# created by doxygen. Using this option one can overrule certain style aspects. +# This is preferred over using HTML_STYLESHEET since it does not replace the +# standard style sheet and is therefore more robust against future updates. +# Doxygen will copy the style sheet files to the output directory. +# Note: The order of the extra style sheet files is of importance (e.g. the last +# style sheet in the list overrules the setting of the previous ones in the +# list). For an example see the documentation. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_EXTRA_STYLESHEET = + +# The HTML_EXTRA_FILES tag can be used to specify one or more extra images or +# other source files which should be copied to the HTML output directory. Note +# that these files will be copied to the base HTML output directory. Use the +# $relpath^ marker in the HTML_HEADER and/or HTML_FOOTER files to load these +# files. In the HTML_STYLESHEET file, use the file name only. Also note that the +# files will be copied as-is; there are no commands or markers available. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_EXTRA_FILES = + +# The HTML_COLORSTYLE_HUE tag controls the color of the HTML output. Doxygen +# will adjust the colors in the style sheet and background images according to +# this color. Hue is specified as an angle on a colorwheel, see +# http://en.wikipedia.org/wiki/Hue for more information. For instance the value +# 0 represents red, 60 is yellow, 120 is green, 180 is cyan, 240 is blue, 300 +# purple, and 360 is red again. +# Minimum value: 0, maximum value: 359, default value: 220. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_COLORSTYLE_HUE = 220 + +# The HTML_COLORSTYLE_SAT tag controls the purity (or saturation) of the colors +# in the HTML output. For a value of 0 the output will use grayscales only. A +# value of 255 will produce the most vivid colors. +# Minimum value: 0, maximum value: 255, default value: 100. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_COLORSTYLE_SAT = 100 + +# The HTML_COLORSTYLE_GAMMA tag controls the gamma correction applied to the +# luminance component of the colors in the HTML output. Values below 100 +# gradually make the output lighter, whereas values above 100 make the output +# darker. The value divided by 100 is the actual gamma applied, so 80 represents +# a gamma of 0.8, The value 220 represents a gamma of 2.2, and 100 does not +# change the gamma. +# Minimum value: 40, maximum value: 240, default value: 80. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_COLORSTYLE_GAMMA = 80 + +# If the HTML_TIMESTAMP tag is set to YES then the footer of each generated HTML +# page will contain the date and time when the page was generated. Setting this +# to NO can help when comparing the output of multiple runs. +# The default value is: YES. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_TIMESTAMP = YES + +# If the HTML_DYNAMIC_SECTIONS tag is set to YES then the generated HTML +# documentation will contain sections that can be hidden and shown after the +# page has loaded. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_DYNAMIC_SECTIONS = YES + +# With HTML_INDEX_NUM_ENTRIES one can control the preferred number of entries +# shown in the various tree structured indices initially; the user can expand +# and collapse entries dynamically later on. Doxygen will expand the tree to +# such a level that at most the specified number of entries are visible (unless +# a fully collapsed tree already exceeds this amount). So setting the number of +# entries 1 will produce a full collapsed tree by default. 0 is a special value +# representing an infinite number of entries and will result in a full expanded +# tree by default. +# Minimum value: 0, maximum value: 9999, default value: 100. +# This tag requires that the tag GENERATE_HTML is set to YES. + +HTML_INDEX_NUM_ENTRIES = 100 + +# If the GENERATE_DOCSET tag is set to YES, additional index files will be +# generated that can be used as input for Apple's Xcode 3 integrated development +# environment (see: http://developer.apple.com/tools/xcode/), introduced with +# OSX 10.5 (Leopard). To create a documentation set, doxygen will generate a +# Makefile in the HTML output directory. Running make will produce the docset in +# that directory and running make install will install the docset in +# ~/Library/Developer/Shared/Documentation/DocSets so that Xcode will find it at +# startup. See http://developer.apple.com/tools/creatingdocsetswithdoxygen.html +# for more information. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +GENERATE_DOCSET = NO + +# This tag determines the name of the docset feed. A documentation feed provides +# an umbrella under which multiple documentation sets from a single provider +# (such as a company or product suite) can be grouped. +# The default value is: Doxygen generated docs. +# This tag requires that the tag GENERATE_DOCSET is set to YES. + +DOCSET_FEEDNAME = "Doxygen generated docs" + +# This tag specifies a string that should uniquely identify the documentation +# set bundle. This should be a reverse domain-name style string, e.g. +# com.mycompany.MyDocSet. Doxygen will append .docset to the name. +# The default value is: org.doxygen.Project. +# This tag requires that the tag GENERATE_DOCSET is set to YES. + +DOCSET_BUNDLE_ID = org.doxygen.Project + +# The DOCSET_PUBLISHER_ID tag specifies a string that should uniquely identify +# the documentation publisher. This should be a reverse domain-name style +# string, e.g. com.mycompany.MyDocSet.documentation. +# The default value is: org.doxygen.Publisher. +# This tag requires that the tag GENERATE_DOCSET is set to YES. + +DOCSET_PUBLISHER_ID = org.doxygen.Publisher + +# The DOCSET_PUBLISHER_NAME tag identifies the documentation publisher. +# The default value is: Publisher. +# This tag requires that the tag GENERATE_DOCSET is set to YES. + +DOCSET_PUBLISHER_NAME = Publisher + +# If the GENERATE_HTMLHELP tag is set to YES then doxygen generates three +# additional HTML index files: index.hhp, index.hhc, and index.hhk. The +# index.hhp is a project file that can be read by Microsoft's HTML Help Workshop +# (see: http://www.microsoft.com/en-us/download/details.aspx?id=21138) on +# Windows. +# +# The HTML Help Workshop contains a compiler that can convert all HTML output +# generated by doxygen into a single compiled HTML file (.chm). Compiled HTML +# files are now used as the Windows 98 help format, and will replace the old +# Windows help format (.hlp) on all Windows platforms in the future. Compressed +# HTML files also contain an index, a table of contents, and you can search for +# words in the documentation. The HTML workshop also contains a viewer for +# compressed HTML files. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +GENERATE_HTMLHELP = NO + +# The CHM_FILE tag can be used to specify the file name of the resulting .chm +# file. You can add a path in front of the file if the result should not be +# written to the html output directory. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + +CHM_FILE = + +# The HHC_LOCATION tag can be used to specify the location (absolute path +# including file name) of the HTML help compiler (hhc.exe). If non-empty, +# doxygen will try to run the HTML help compiler on the generated index.hhp. +# The file has to be specified with full path. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + +HHC_LOCATION = + +# The GENERATE_CHI flag controls if a separate .chi index file is generated +# (YES) or that it should be included in the master .chm file (NO). +# The default value is: NO. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + +GENERATE_CHI = NO + +# The CHM_INDEX_ENCODING is used to encode HtmlHelp index (hhk), content (hhc) +# and project file content. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + +CHM_INDEX_ENCODING = + +# The BINARY_TOC flag controls whether a binary table of contents is generated +# (YES) or a normal table of contents (NO) in the .chm file. Furthermore it +# enables the Previous and Next buttons. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + +BINARY_TOC = NO + +# The TOC_EXPAND flag can be set to YES to add extra items for group members to +# the table of contents of the HTML help documentation and to the tree view. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTMLHELP is set to YES. + +TOC_EXPAND = NO + +# If the GENERATE_QHP tag is set to YES and both QHP_NAMESPACE and +# QHP_VIRTUAL_FOLDER are set, an additional index file will be generated that +# can be used as input for Qt's qhelpgenerator to generate a Qt Compressed Help +# (.qch) of the generated HTML documentation. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +GENERATE_QHP = NO + +# If the QHG_LOCATION tag is specified, the QCH_FILE tag can be used to specify +# the file name of the resulting .qch file. The path specified is relative to +# the HTML output folder. +# This tag requires that the tag GENERATE_QHP is set to YES. + +QCH_FILE = + +# The QHP_NAMESPACE tag specifies the namespace to use when generating Qt Help +# Project output. For more information please see Qt Help Project / Namespace +# (see: http://qt-project.org/doc/qt-4.8/qthelpproject.html#namespace). +# The default value is: org.doxygen.Project. +# This tag requires that the tag GENERATE_QHP is set to YES. + +QHP_NAMESPACE = org.doxygen.Project + +# The QHP_VIRTUAL_FOLDER tag specifies the namespace to use when generating Qt +# Help Project output. For more information please see Qt Help Project / Virtual +# Folders (see: http://qt-project.org/doc/qt-4.8/qthelpproject.html#virtual- +# folders). +# The default value is: doc. +# This tag requires that the tag GENERATE_QHP is set to YES. + +QHP_VIRTUAL_FOLDER = doc + +# If the QHP_CUST_FILTER_NAME tag is set, it specifies the name of a custom +# filter to add. For more information please see Qt Help Project / Custom +# Filters (see: http://qt-project.org/doc/qt-4.8/qthelpproject.html#custom- +# filters). +# This tag requires that the tag GENERATE_QHP is set to YES. + +QHP_CUST_FILTER_NAME = + +# The QHP_CUST_FILTER_ATTRS tag specifies the list of the attributes of the +# custom filter to add. For more information please see Qt Help Project / Custom +# Filters (see: http://qt-project.org/doc/qt-4.8/qthelpproject.html#custom- +# filters). +# This tag requires that the tag GENERATE_QHP is set to YES. + +QHP_CUST_FILTER_ATTRS = + +# The QHP_SECT_FILTER_ATTRS tag specifies the list of the attributes this +# project's filter section matches. Qt Help Project / Filter Attributes (see: +# http://qt-project.org/doc/qt-4.8/qthelpproject.html#filter-attributes). +# This tag requires that the tag GENERATE_QHP is set to YES. + +QHP_SECT_FILTER_ATTRS = + +# The QHG_LOCATION tag can be used to specify the location of Qt's +# qhelpgenerator. If non-empty doxygen will try to run qhelpgenerator on the +# generated .qhp file. +# This tag requires that the tag GENERATE_QHP is set to YES. + +QHG_LOCATION = + +# If the GENERATE_ECLIPSEHELP tag is set to YES, additional index files will be +# generated, together with the HTML files, they form an Eclipse help plugin. To +# install this plugin and make it available under the help contents menu in +# Eclipse, the contents of the directory containing the HTML and XML files needs +# to be copied into the plugins directory of eclipse. The name of the directory +# within the plugins directory should be the same as the ECLIPSE_DOC_ID value. +# After copying Eclipse needs to be restarted before the help appears. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +GENERATE_ECLIPSEHELP = NO + +# A unique identifier for the Eclipse help plugin. When installing the plugin +# the directory name containing the HTML and XML files should also have this +# name. Each documentation set should have its own identifier. +# The default value is: org.doxygen.Project. +# This tag requires that the tag GENERATE_ECLIPSEHELP is set to YES. + +ECLIPSE_DOC_ID = org.doxygen.Project + +# If you want full control over the layout of the generated HTML pages it might +# be necessary to disable the index and replace it with your own. The +# DISABLE_INDEX tag can be used to turn on/off the condensed index (tabs) at top +# of each HTML page. A value of NO enables the index and the value YES disables +# it. Since the tabs in the index contain the same information as the navigation +# tree, you can set this option to YES if you also set GENERATE_TREEVIEW to YES. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +DISABLE_INDEX = NO + +# The GENERATE_TREEVIEW tag is used to specify whether a tree-like index +# structure should be generated to display hierarchical information. If the tag +# value is set to YES, a side panel will be generated containing a tree-like +# index structure (just like the one that is generated for HTML Help). For this +# to work a browser that supports JavaScript, DHTML, CSS and frames is required +# (i.e. any modern browser). Windows users are probably better off using the +# HTML help feature. Via custom style sheets (see HTML_EXTRA_STYLESHEET) one can +# further fine-tune the look of the index. As an example, the default style +# sheet generated by doxygen has an example that shows how to put an image at +# the root of the tree instead of the PROJECT_NAME. Since the tree basically has +# the same information as the tab index, you could consider setting +# DISABLE_INDEX to YES when enabling this option. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +GENERATE_TREEVIEW = YES + +# The ENUM_VALUES_PER_LINE tag can be used to set the number of enum values that +# doxygen will group on one line in the generated HTML documentation. +# +# Note that a value of 0 will completely suppress the enum values from appearing +# in the overview section. +# Minimum value: 0, maximum value: 20, default value: 4. +# This tag requires that the tag GENERATE_HTML is set to YES. + +ENUM_VALUES_PER_LINE = 4 + +# If the treeview is enabled (see GENERATE_TREEVIEW) then this tag can be used +# to set the initial width (in pixels) of the frame in which the tree is shown. +# Minimum value: 0, maximum value: 1500, default value: 250. +# This tag requires that the tag GENERATE_HTML is set to YES. + +TREEVIEW_WIDTH = 250 + +# If the EXT_LINKS_IN_WINDOW option is set to YES, doxygen will open links to +# external symbols imported via tag files in a separate window. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +EXT_LINKS_IN_WINDOW = NO + +# Use this tag to change the font size of LaTeX formulas included as images in +# the HTML documentation. When you change the font size after a successful +# doxygen run you need to manually remove any form_*.png images from the HTML +# output directory to force them to be regenerated. +# Minimum value: 8, maximum value: 50, default value: 10. +# This tag requires that the tag GENERATE_HTML is set to YES. + +FORMULA_FONTSIZE = 10 + +# Use the FORMULA_TRANPARENT tag to determine whether or not the images +# generated for formulas are transparent PNGs. Transparent PNGs are not +# supported properly for IE 6.0, but are supported on all modern browsers. +# +# Note that when changing this option you need to delete any form_*.png files in +# the HTML output directory before the changes have effect. +# The default value is: YES. +# This tag requires that the tag GENERATE_HTML is set to YES. + +FORMULA_TRANSPARENT = YES + +# Enable the USE_MATHJAX option to render LaTeX formulas using MathJax (see +# http://www.mathjax.org) which uses client side Javascript for the rendering +# instead of using pre-rendered bitmaps. Use this if you do not have LaTeX +# installed or if you want to formulas look prettier in the HTML output. When +# enabled you may also need to install MathJax separately and configure the path +# to it using the MATHJAX_RELPATH option. +# The default value is: NO. +# This tag requires that the tag GENERATE_HTML is set to YES. + +USE_MATHJAX = NO + +# When MathJax is enabled you can set the default output format to be used for +# the MathJax output. See the MathJax site (see: +# http://docs.mathjax.org/en/latest/output.html) for more details. +# Possible values are: HTML-CSS (which is slower, but has the best +# compatibility), NativeMML (i.e. MathML) and SVG. +# The default value is: HTML-CSS. +# This tag requires that the tag USE_MATHJAX is set to YES. + +MATHJAX_FORMAT = HTML-CSS + +# When MathJax is enabled you need to specify the location relative to the HTML +# output directory using the MATHJAX_RELPATH option. The destination directory +# should contain the MathJax.js script. For instance, if the mathjax directory +# is located at the same level as the HTML output directory, then +# MATHJAX_RELPATH should be ../mathjax. The default value points to the MathJax +# Content Delivery Network so you can quickly see the result without installing +# MathJax. However, it is strongly recommended to install a local copy of +# MathJax from http://www.mathjax.org before deployment. +# The default value is: http://cdn.mathjax.org/mathjax/latest. +# This tag requires that the tag USE_MATHJAX is set to YES. + +MATHJAX_RELPATH = http://cdn.mathjax.org/mathjax/latest + +# The MATHJAX_EXTENSIONS tag can be used to specify one or more MathJax +# extension names that should be enabled during MathJax rendering. For example +# MATHJAX_EXTENSIONS = TeX/AMSmath TeX/AMSsymbols +# This tag requires that the tag USE_MATHJAX is set to YES. + +MATHJAX_EXTENSIONS = + +# The MATHJAX_CODEFILE tag can be used to specify a file with javascript pieces +# of code that will be used on startup of the MathJax code. See the MathJax site +# (see: http://docs.mathjax.org/en/latest/output.html) for more details. For an +# example see the documentation. +# This tag requires that the tag USE_MATHJAX is set to YES. + +MATHJAX_CODEFILE = + +# When the SEARCHENGINE tag is enabled doxygen will generate a search box for +# the HTML output. The underlying search engine uses javascript and DHTML and +# should work on any modern browser. Note that when using HTML help +# (GENERATE_HTMLHELP), Qt help (GENERATE_QHP), or docsets (GENERATE_DOCSET) +# there is already a search function so this one should typically be disabled. +# For large projects the javascript based search engine can be slow, then +# enabling SERVER_BASED_SEARCH may provide a better solution. It is possible to +# search using the keyboard; to jump to the search box use + S +# (what the is depends on the OS and browser, but it is typically +# , /