Changeset 6204
- Timestamp:
- 2016-01-04T14:47:06+01:00 (9 years ago)
- Location:
- branches/2015/nemo_v3_6_STABLE/NEMOGCM
- Files:
-
- 1 deleted
- 97 edited
- 2 copied
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/CMCC/arch-PW6_calypso.fcm
r4865 r6204 13 13 # USER_INC additional include files for the compiler, e.g. -I<include dir> 14 14 # USER_LIB additional libraries to pass to the linker, e.g. -l<library> 15 # CC C compiler used to compile conv for AGRIF 16 # CFLAGS compiler flags used with CC 15 17 16 18 … … 29 31 %USER_INC %NCDF_INC 30 32 %USER_LIB %NCDF_LIB 33 %CC xlc 34 %CFLAGS -O -qcpluscmt -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/CMCC/arch-PW6_calypso_debug.fcm
r4865 r6204 13 13 # USER_INC additional include files for the compiler, e.g. -I<include dir> 14 14 # USER_LIB additional libraries to pass to the linker, e.g. -l<library> 15 # CC C compiler used to compile conv for AGRIF 16 # CFLAGS compiler flags used with CC 15 17 16 18 … … 29 31 %USER_INC %NCDF_INC 30 32 %USER_LIB %NCDF_LIB 33 %CC xlc 34 %CFLAGS -O -qcpluscmt -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/CMCC/arch-PW6_calypso_tools.fcm
r4865 r6204 13 13 # USER_INC additional include files for the compiler, e.g. -I<include dir> 14 14 # USER_LIB additional libraries to pass to the linker, e.g. -l<library> 15 # CC C compiler used to compile conv for AGRIF 16 # CFLAGS compiler flags used with CC 15 17 16 18 … … 29 31 %USER_INC %NCDF_INC 30 32 %USER_LIB %NCDF_LIB 33 %CC xlc 34 %CFLAGS -O -qcpluscmt -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/CMCC/arch-gfortran_athena_xios.fcm
r4865 r6204 25 25 # USER_INC complete list of include files 26 26 # USER_LIB complete list of libraries to pass to the linker 27 # CC C compiler used to compile conv for AGRIF 28 # CFLAGS compiler flags used with CC 27 29 # 28 30 # Note that: … … 56 58 %USER_INC %XIOS_INC %NCDF_INC %HDF5_INC 57 59 %USER_LIB %XIOS_LIB %NCDF_LIB %HDF5_LIB -lnetcdff -lnetcdf -lstdc++ -lz -lcurl -lgpfs 60 61 %CC cc 62 %CFLAGS -O0 -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/CMCC/arch-ifort_athena.fcm
r4865 r6204 13 13 # USER_INC additional include files for the compiler, e.g. -I<include dir> 14 14 # USER_LIB additional libraries to pass to the linker, e.g. -l<library> 15 # CC C compiler used to compile conv for AGRIF 16 # CFLAGS compiler flags used with CC 15 17 16 18 … … 29 31 %USER_INC %NCDF_INC 30 32 %USER_LIB %NCDF_LIB 33 %CC icc 34 %CFLAGS -O0 31 35 -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/CMCC/arch-ifort_athena_debug.fcm
r4865 r6204 13 13 # USER_INC additional include files for the compiler, e.g. -I<include dir> 14 14 # USER_LIB additional libraries to pass to the linker, e.g. -l<library> 15 # CC C compiler used to compile conv for AGRIF 16 # CFLAGS compiler flags used with CC 15 17 16 18 … … 29 31 %USER_INC %NCDF_INC 30 32 %USER_LIB %NCDF_LIB 33 %CC icc 34 %CFLAGS -O0 31 35 -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/CMCC/arch-ifort_athena_tools.fcm
r4865 r6204 13 13 # USER_INC additional include files for the compiler, e.g. -I<include dir> 14 14 # USER_LIB additional libraries to pass to the linker, e.g. -l<library> 15 # CC C compiler used to compile conv for AGRIF 16 # CFLAGS compiler flags used with CC 15 17 16 18 … … 29 31 %USER_INC %NCDF_INC 30 32 %USER_LIB %NCDF_LIB 33 %CC icc 34 %CFLAGS -O0 31 35 -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/CMCC/arch-ifort_athena_xios.fcm
r4997 r6204 25 25 # USER_INC complete list of include files 26 26 # USER_LIB complete list of libraries to pass to the linker 27 # CC C compiler used to compile conv for AGRIF 28 # CFLAGS compiler flags used with CC 27 29 # 28 30 # Note that: … … 55 57 %USER_INC %XIOS_INC %NCDF_INC %HDF5_INC 56 58 %USER_LIB %XIOS_LIB %NCDF_LIB %HDF5_LIB 59 %CC icc 60 %CFLAGS -O0 -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/INGV/arch-IBM_EKMAN_INGV.fcm
r5301 r6204 15 15 # USER_INC additional include files for the compiler, e.g. -I<include dir> 16 16 # USER_LIB additional libraries to pass to the linker, e.g. -l<library> 17 # CC C compiler used to compile conv for AGRIF 18 # CFLAGS compiler flags used with CC 17 19 18 20 %NCDF_INC -I/srv/lib/netcdf-x/include -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/arch-ALTIX_NAUTILUS_MPT.fcm
r5385 r6204 24 24 # USER_INC complete list of include files 25 25 # USER_LIB complete list of libraries to pass to the linker 26 # CC C compiler used to compile conv for AGRIF 27 # CFLAGS compiler flags used with CC 26 28 # 27 29 # Note that: … … 58 60 #FCFLAGS -g -traceback -r8 -O0 -xT -ip -vec-report0 59 61 #FFLAGS -g -traceback -r8 -O0 -xT -ip -vec-report0 62 63 %CC cc 64 %CFLAGS -O0 -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/arch-PW7_C2A_XIO.fcm
r4865 r6204 17 17 # USER_INC complete list of include files 18 18 # USER_LIB complete list of libraries to pass to the linker 19 # CC C compiler used to compile conv for AGRIF 20 # CFLAGS compiler flags used with CC 19 21 # 20 22 # Note that: … … 48 50 %USER_INC %XIOS_INC %NCDF_INC 49 51 %USER_LIB %XIOS_LIB %NCDF_LIB %XLF90_LIB 52 53 %CC xlc 54 %CFLAGS -O -qcpluscmt -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/arch-PW7_METO.fcm
r5415 r6204 15 15 # USER_INC additional include files for the compiler, e.g. -I<include dir> 16 16 # USER_LIB additional libraries to pass to the linker, e.g. -l<library> 17 # CC C compiler used to compile conv for AGRIF 18 # CFLAGS compiler flags used with CC 17 19 18 20 … … 24 26 %FC mpxlf90_r 25 27 %FCFLAGS -qrealsize=8 -qextname -qsuffix=f=f90 -qarch=pwr7 -qtune=pwr7 -g -O2 -qstrict -qinitauto=7FBFFFFF 26 %FFLAGS -qrealsize=8 -qextname -qarch=pwr7 -qtune=pwr7 -g -O2 -qstrict -qinitauto=7FBFFFFF -qfixed28 %FFLAGS -qrealsize=8 -qextname -qsuffix=f=f90 -qarch=pwr7 -qtune=pwr7 -g -O2 -qstrict -qinitauto=7FBFFFFF 27 29 %LD mpCC_r 28 30 %LDFLAGS -lxlf90 -L/projects/um1/lib -lsig -O2 -L MASS … … 33 35 %USER_INC %NCDF_INC %XIOS_INC 34 36 %USER_LIB %NCDF_LIB %XIOS_LIB 37 %CC xlc 38 %CFLAGS -O -qcpluscmt -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/arch-PW7_MONSOON.fcm
r5027 r6204 15 15 # USER_INC additional include files for the compiler, e.g. -I<include dir> 16 16 # USER_LIB additional libraries to pass to the linker, e.g. -l<library> 17 # CC C compiler used to compile conv for AGRIF 18 # CFLAGS compiler flags used with CC 17 19 18 20 %NCDF_INC -I/home/dcalve/netcdf/4.1.3_seq/include … … 32 34 %USER_INC %NCDF_INC %XIOS_INC 33 35 %USER_LIB %NCDF_LIB %XIOS_LIB 36 37 %CC xlc 38 %CFLAGS -O -qcpluscmt -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/arch-X64_ADA.fcm
r5385 r6204 24 24 # USER_INC complete list of include files 25 25 # USER_LIB complete list of libraries to pass to the linker 26 # CC C compiler used to compile conv for AGRIF 27 # CFLAGS compiler flags used with CC 26 28 # 27 29 # Note that: … … 54 56 %USER_INC %XIOS_INC %OASIS_INC %NCDF_INC 55 57 %USER_LIB %XIOS_LIB %OASIS_LIB %NCDF_LIB 58 59 %CC icc 60 %CFLAGS -O0 -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/arch-X64_ADA_O0.fcm
r4990 r6204 24 24 # USER_INC complete list of include files 25 25 # USER_LIB complete list of libraries to pass to the linker 26 # CC C compiler used to compile conv for AGRIF 27 # CFLAGS compiler flags used with CC 26 28 # 27 29 # Note that: … … 53 55 %USER_INC %XIOS_INC %OASIS_INC %NCDF_INC 54 56 %USER_LIB %XIOS_LIB %OASIS_LIB %NCDF_LIB 57 58 %CC icc 59 %CFLAGS -O0 -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/arch-X64_CURIE.fcm
r5407 r6204 24 24 # USER_INC complete list of include files 25 25 # USER_LIB complete list of libraries to pass to the linker 26 # CC C compiler used to compile conv for AGRIF 27 # CFLAGS compiler flags used with CC 26 28 # 27 29 # Note that: … … 58 60 %USER_INC %XIOS_INC %OASIS_INC %NCDF_INC 59 61 %USER_LIB %XIOS_LIB %OASIS_LIB %NCDF_LIB 62 63 %CC cc 64 %CFLAGS -O0 -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/arch-X64_MOBILIS.fcm
r5118 r6204 29 29 # USER_INC complete list of include files 30 30 # USER_LIB complete list of libraries to pass to the linker 31 # CC C compiler used to compile conv for AGRIF 32 # CFLAGS compiler flags used with CC 31 33 # 32 34 # Note that: … … 58 60 %USER_INC %XIOS_INC %OASIS_INC %NCDF_INC 59 61 %USER_LIB %XIOS_LIB %OASIS_LIB %NCDF_LIB 62 63 %CC cc 64 %CFLAGS -O0 -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/arch-X64_VAYU.fcm
r4865 r6204 24 24 # USER_INC complete list of include files 25 25 # USER_LIB complete list of libraries to pass to the linker 26 # CC C compiler used to compile conv for AGRIF 27 # CFLAGS compiler flags used with CC 26 28 # 27 29 # Note that: … … 53 55 %USER_INC %XIOS_INC %OASIS_INC %NCDF_INC 54 56 %USER_LIB %XIOS_LIB %OASIS_LIB %NCDF_LIB 57 58 %CC cc 59 %CFLAGS -O0 -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/arch-X64_YELLOWSTONE.fcm
r4865 r6204 24 24 # USER_INC complete list of include files 25 25 # USER_LIB complete list of libraries to pass to the linker 26 # CC C compiler used to compile conv for AGRIF 27 # CFLAGS compiler flags used with CC 26 28 # 27 29 # Note that: … … 53 55 %USER_INC %XIOS_INC %OASIS_INC %NCDF_INC 54 56 %USER_LIB %XIOS_LIB %OASIS_LIB %NCDF_LIB 57 58 %CC cc 59 %CFLAGS -O0 -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/arch-XC40_METO.fcm
r5480 r6204 24 24 # USER_INC complete list of include files 25 25 # USER_LIB complete list of libraries to pass to the linker 26 # CC C compiler used to compile conv for AGRIF 27 # CFLAGS compiler flags used with CC 26 28 # 27 29 # Note that: … … 31 33 %NCDF_HOME /opt/cray/netcdf-hdf5parallel/4.3.2/CRAY/83 32 34 %HDF5_HOME /opt/cray/hdf5-parallel/1.8.13/CRAY/83 33 %XIOS_HOME /projects/ocean/nemo/xios/xios_1.0_r6 18_20150619/XIOS35 %XIOS_HOME /projects/ocean/nemo/xios/xios_1.0_r629_20150625/XIOS 34 36 35 37 %NCDF_INC -I%NCDF_HOME/include -I%HDF5_HOME/include … … 51 53 %USER_INC %XIOS_INC 52 54 %USER_LIB %XIOS_LIB 55 56 %CC cc 57 %CFLAGS -O0 -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/arch-XC_ARCHER.fcm
r4865 r6204 24 24 # USER_INC complete list of include files 25 25 # USER_LIB complete list of libraries to pass to the linker 26 # CC C compiler used to compile conv for AGRIF 27 # CFLAGS compiler flags used with CC 26 28 # 27 29 # Note that: … … 57 59 #USER_INC %XIOS_INC %OASIS_INC %NCDF_INC 58 60 #USER_LIB %XIOS_LIB %OASIS_LIB %NCDF_LIB 61 62 %CC cc 63 %CFLAGS -O0 -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/arch-XC_ARCHER_INTEL.fcm
r4865 r6204 24 24 # USER_INC complete list of include files 25 25 # USER_LIB complete list of libraries to pass to the linker 26 # CC C compiler used to compile conv for AGRIF 27 # CFLAGS compiler flags used with CC 26 28 # 27 29 # Note that: … … 55 57 #USER_INC %XIOS_INC %OASIS_INC %NCDF_INC 56 58 #USER_LIB %XIOS_LIB %OASIS_LIB %NCDF_LIB 59 60 %CC cc 61 %CFLAGS -O0 -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/arch-macport_osx.fcm
r5407 r6204 33 33 # USER_INC complete list of include files 34 34 # USER_LIB complete list of libraries to pass to the linker 35 # CC C compiler used to compile conv for AGRIF 36 # CFLAGS compiler flags used with CC 35 37 # 36 38 # Note that: … … 62 64 %USER_INC %XIOS_INC %OASIS_INC %NCDF_INC 63 65 %USER_LIB %XIOS_LIB %OASIS_LIB %NCDF_LIB 66 67 %CC cc 68 %CFLAGS -O0 -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/ARCH/arch-openmpi_NAVITI_MERCATOR.fcm
r4865 r6204 13 13 # USER_INC additional include files for the compiler, e.g. -I<include dir> 14 14 # USER_LIB additional libraries to pass to the linker, e.g. -l<library> 15 # CC C compiler used to compile conv for AGRIF 16 # CFLAGS compiler flags used with CC 15 17 # debug: -g -check bounds -check uninit -check pointers -traceback 16 18 … … 31 33 %USER_INC -I$XIOS_INC %NCDF_INC 32 34 %USER_LIB -L$XIOS_LIB -lxios %NCDF_LIB -lstdc++ 35 36 %CC cc 37 %CFLAGS -O0 -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/iodef.xml
r5363 r6204 2 2 <simulation> 3 3 4 <context id="nemo" time_origin="1900-01-01 00:00:00">4 <context id="nemo" > 5 5 6 6 <!-- $id$ --> … … 19 19 = put the variables you want... = 20 20 ============================================================================================================ 21 --> 22 23 <file_definition type="multiple_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="1d" min_digits="4"> 24 25 <file_group id="1ts" output_freq="1ts" output_level="10" enabled=".TRUE."/> <!-- 1 time step files --> 26 <file_group id="1h" output_freq="1h" output_level="10" enabled=".TRUE."/> <!-- 1h files --> 27 <file_group id="2h" output_freq="2h" output_level="10" enabled=".TRUE."/> <!-- 2h files --> 28 <file_group id="3h" output_freq="3h" output_level="10" enabled=".TRUE."/> <!-- 3h files --> 29 <file_group id="4h" output_freq="4h" output_level="10" enabled=".TRUE."/> <!-- 4h files --> 30 <file_group id="6h" output_freq="6h" output_level="10" enabled=".TRUE."/> <!-- 6h files --> 31 32 <file_group id="1d" output_freq="1d" output_level="10" enabled=".TRUE."/> <!-- 1d files --> 33 <file_group id="3d" output_freq="3d" output_level="10" enabled=".TRUE."/> <!-- 3d files --> 34 <file_group id="5d" output_freq="5d" output_level="10" enabled=".TRUE."> <!-- 5d files --> 21 --> 22 23 <file_definition src="./file_def.xml"/> 24 25 <!-- 35 26 36 <file id="file1" name_suffix="_grid_T" description="ocean T grid variables" >37 <field field_ref="toce" name="votemper" />38 <field field_ref="soce" name="vosaline" />39 <field field_ref="sst" name="sosstsst" />40 <field field_ref="sss" name="sosaline" />41 <field field_ref="ssh" name="sossheig" />42 <field field_ref="empmr" name="sowaflup" />43 <field field_ref="qsr" name="soshfldo" />44 <field field_ref="saltflx" name="sosfldow" />45 <field field_ref="qt" name="sohefldo" />46 <field field_ref="mldr10_1" name="somxl010" />47 <field field_ref="mldkz5" name="somixhgt" />48 </file>49 50 <file id="file2" name_suffix="_grid_U" description="ocean U grid variables" >51 <field field_ref="uoce" name="vozocrtx" />52 <field field_ref="utau" name="sozotaux" />53 </file>54 55 <file id="file3" name_suffix="_grid_V" description="ocean V grid variables" >56 <field field_ref="voce" name="vomecrty" />57 <field field_ref="vtau" name="sometauy" />58 </file>59 60 <file id="file4" name_suffix="_grid_W" description="ocean W grid variables" >61 <field field_ref="woce" name="vovecrtz" />62 <field field_ref="avt" name="votkeavt" />63 <field field_ref="aht2d" name="soleahtw" />64 </file>65 66 </file_group>67 68 <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files -->69 <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files -->70 <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files -->71 <file_group id="4m" output_freq="4mo" output_level="10" enabled=".TRUE."/> <!-- real 4m files -->72 <file_group id="6m" output_freq="6mo" output_level="10" enabled=".TRUE."/> <!-- real 6m files -->73 74 <file_group id="1y" output_freq="1y" output_level="10" enabled=".TRUE."/> <!-- real yearly files -->75 <file_group id="2y" output_freq="2y" output_level="10" enabled=".TRUE."/> <!-- real 2y files -->76 <file_group id="5y" output_freq="5y" output_level="10" enabled=".TRUE."/> <!-- real 5y files -->77 <file_group id="10y" output_freq="10y" output_level="10" enabled=".TRUE."/> <!-- real 10y files -->78 79 </file_definition>80 81 <!--82 27 ============================================================================================================ 83 28 = grid definition = = DO NOT CHANGE = … … 100 45 101 46 <grid_definition> 102 <grid id="grid_T_2D" domain_ref="grid_T"/> 103 <grid id="grid_T_3D" domain_ref="grid_T" axis_ref="deptht"/> 104 <grid id="grid_U_2D" domain_ref="grid_U"/> 105 <grid id="grid_U_3D" domain_ref="grid_U" axis_ref="depthu"/> 106 <grid id="grid_V_2D" domain_ref="grid_V"/> 107 <grid id="grid_V_3D" domain_ref="grid_V" axis_ref="depthv"/> 108 <grid id="grid_W_2D" domain_ref="grid_W"/> 109 <grid id="grid_W_3D" domain_ref="grid_W" axis_ref="depthw"/> 47 <grid id="grid_T_2D" > 48 <domain id="grid_T" /> 49 </grid> 50 <grid id="grid_T_3D" > 51 <domain id="grid_T" /> 52 <axis id="deptht" /> 53 </grid> 54 <grid id="grid_U_2D" > 55 <domain id="grid_U" /> 56 </grid> 57 <grid id="grid_U_3D" > 58 <domain id="grid_U" /> 59 <axis id="depthu" /> 60 </grid> 61 <grid id="grid_V_2D" > 62 <domain id="grid_V" /> 63 </grid> 64 <grid id="grid_V_3D" > 65 <domain id="grid_V" /> 66 <axis id="depthv" /> 67 </grid> 68 <grid id="grid_W_2D" > 69 <domain id="grid_W" /> 70 </grid> 71 <grid id="grid_W_3D" > 72 <domain id="grid_W" /> 73 <axis id="depthw" /> 74 </grid> 75 <grid id="scalarpoint" /> 76 110 77 </grid_definition> 111 78 … … 120 87 We must have buffer_size > jpi*jpj*jpk*8 (with jpi and jpj the subdomain size) 121 88 --> 122 <variable id="buffer_size" type="integer">10000000</variable> 123 <variable id="buffer_server_factor_size" type="integer">2</variable> 124 <variable id="info_level" type="integer">0</variable> 125 <variable id="using_server" type="boolean">false</variable> 126 <variable id="using_oasis" type="boolean">false</variable> 89 <variable id="info_level" type="int">0</variable> 90 <variable id="using_server" type="bool">false</variable> 91 <variable id="using_oasis" type="bool">false</variable> 127 92 <variable id="oasis_codes_id" type="string" >oceanx</variable> 128 93 -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/CONFIG/GYRE_XIOS/cpp_GYRE_XIOS.fcm
r4373 r6204 1 bld::tool::fppkeys key_dynspg_flt key_ldfslp key_zdftke key_iomput key_mpp_mpi 1 bld::tool::fppkeys key_dynspg_flt key_ldfslp key_zdftke key_iomput key_mpp_mpi key_xios2 -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist_cfg
r5499 r6204 6 6 !----------------------------------------------------------------------- 7 7 cn_exp = "Agulhas" ! experience name 8 nn_itend = 480 ! last time step8 nn_itend = 10950 ! last time step 9 9 nn_stock = 10950 ! frequency of creation of a restart file (modulo referenced to 1) 10 10 nn_write = 10950 ! frequency of write in the output file (modulo referenced to nn_it000) -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/iodef.xml
r5407 r6204 153 153 </context> 154 154 155 <context id="1_nemo" time_origin="1950-01-01 00:00:00" > 156 157 <!-- $id$ --> 158 159 <!-- 160 ============================================================================================================ 161 = definition of all existing variables = 162 = DO NOT CHANGE = 163 ============================================================================================================ 164 --> 165 <field_definition src="./field_def.xml"/> 166 <!-- 167 ============================================================================================================ 168 = output files definition = 169 = Define your own files = 170 = put the variables you want... = 171 ============================================================================================================ 172 --> 173 174 <file_definition type="multiple_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="10d" min_digits="4"> 175 176 <file_group id="1ts" output_freq="1ts" output_level="10" enabled=".TRUE."/> <!-- 1 time step files --> 177 <file_group id="1h" output_freq="1h" output_level="10" enabled=".TRUE."/> <!-- 1h files --> 178 <file_group id="2h" output_freq="2h" output_level="10" enabled=".TRUE."/> <!-- 2h files --> 179 <file_group id="3h" output_freq="3h" output_level="10" enabled=".TRUE."/> <!-- 3h files --> 180 <file_group id="4h" output_freq="4h" output_level="10" enabled=".TRUE."/> <!-- 4h files --> 181 <file_group id="6h" output_freq="6h" output_level="10" enabled=".TRUE."/> <!-- 6h files --> 182 <file_group id="1d" output_freq="1d" output_level="10" enabled=".TRUE."/> <!-- 1d files --> 183 <file_group id="3d" output_freq="3d" output_level="10" enabled=".TRUE."/> <!-- 3d files --> 184 185 <file_group id="5d" output_freq="5d" output_level="10" enabled=".TRUE." > <!-- 5d files --> 186 187 <file id="file1" name_suffix="_grid_T" description="ocean T grid variables" > 188 <field field_ref="sst" name="tos" long_name="sea_surface_temperature" /> 189 <field field_ref="sss" name="sos" long_name="sea_surface_salinity" /> 190 <field field_ref="ssh" name="zos" long_name="sea_surface_height_above_geoid" /> 191 <field field_ref="toce" name="thetao" long_name="sea_water_potential_temperature" /> 192 <field field_ref="soce" name="so" long_name="sea_water_salinity" /> 193 <field field_ref="sst2" name="tossq" long_name="square_of_sea_surface_temperature" /> 194 <field field_ref="ssh2" name="zossq" long_name="square_of_sea_surface_height_above_geoid" /> 195 <field field_ref="mldkz5" /> 196 <field field_ref="mldr10_1" /> 197 <field field_ref="empmr" name="wfo" long_name="water_flux_into_sea_water" /> 198 <field field_ref="qsr" name="rsntds" long_name="surface_net_downward_shortwave_flux" /> 199 <field field_ref="qt" name="tohfls" long_name="surface_net_downward_total_heat_flux" /> 200 <field field_ref="saltflx" name="sosflxdo" /> 201 <field field_ref="taum" name="taum" /> 202 <field field_ref="wspd" name="sowindsp" /> 203 <field field_ref="precip" name="soprecip" /> 204 </file> 205 206 <file id="file3" name_suffix="_grid_U" description="ocean U grid variables" > 207 <field field_ref="ssu" name="uos" long_name="sea_surface_x_velocity" /> 208 <field field_ref="uoce" name="uo" long_name="sea_water_x_velocity" /> 209 <field field_ref="utau" name="tauuo" long_name="surface_downward_x_stress" /> 210 <!-- variables available with MLE 211 <field field_ref="psiu_mle" name="psiu_mle" long_name="MLE_streamfunction_along_i-axis" /> 212 --> 213 </file> 214 215 <file id="file4" name_suffix="_grid_V" description="ocean V grid variables" > 216 <field field_ref="ssv" name="vos" long_name="sea_surface_y_velocity" /> 217 <field field_ref="voce" name="vo" long_name="sea_water_y_velocity" /> 218 <field field_ref="vtau" name="tauvo" long_name="surface_downward_y_stress" /> 219 <!-- variables available with MLE 220 <field field_ref="psiv_mle" name="psiv_mle" long_name="MLE_streamfunction_along_j-axis" /> 221 --> 222 </file> 223 224 <file id="file5" name_suffix="_grid_W" description="ocean W grid variables" > 225 <field field_ref="woce" name="wo" long_name="ocean vertical velocity" /> 226 <field field_ref="avt" name="difvho" long_name="ocean_vertical_heat_diffusivity" /> 227 </file> 228 <!-- 229 <file id="file6" name_suffix="_icemod" description="ice variables" > 230 <field field_ref="ice_pres" /> 231 <field field_ref="snowthic_cea" name="snd" long_name="surface_snow_thickness" /> 232 <field field_ref="icethic_cea" name="sit" long_name="sea_ice_thickness" /> 233 <field field_ref="iceprod_cea" name="sip" long_name="sea_ice_thickness" /> 234 <field field_ref="ist_ipa" /> 235 <field field_ref="uice_ipa" /> 236 <field field_ref="vice_ipa" /> 237 <field field_ref="utau_ice" /> 238 <field field_ref="vtau_ice" /> 239 <field field_ref="qsr_io_cea" /> 240 <field field_ref="qns_io_cea" /> 241 <field field_ref="snowpre" /> 242 </file> 243 244 <file id="file8" name_suffix="_Tides" description="tidal harmonics" > 245 <field field_ref="M2x" name="M2x" long_name="M2 Elevation harmonic real part" /> 246 <field field_ref="M2y" name="M2y" long_name="M2 Elevation harmonic imaginary part" /> 247 <field field_ref="M2x_u" name="M2x_u" long_name="M2 current barotrope along i-axis harmonic real part " /> 248 <field field_ref="M2y_u" name="M2y_u" long_name="M2 current barotrope along i-axis harmonic imaginary part " /> 249 <field field_ref="M2x_v" name="M2x_v" long_name="M2 current barotrope along j-axis harmonic real part " /> 250 <field field_ref="M2y_v" name="M2y_v" long_name="M2 current barotrope along j-axis harmonic imaginary part " /> 251 </file> 252 --> 253 </file_group> 254 255 256 <file_group id="1m" output_freq="1mo" output_level="10" enabled=".TRUE."/> <!-- real monthly files --> 257 258 259 <file_group id="2m" output_freq="2mo" output_level="10" enabled=".TRUE."/> <!-- real 2m files --> 260 <file_group id="3m" output_freq="3mo" output_level="10" enabled=".TRUE."/> <!-- real 3m files --> 261 <file_group id="4m" output_freq="4mo" output_level="10" enabled=".TRUE."/> <!-- real 4m files --> 262 <file_group id="6m" output_freq="6mo" output_level="10" enabled=".TRUE."/> <!-- real 6m files --> 263 264 <file_group id="1y" output_freq="1y" output_level="10" enabled=".TRUE."/> <!-- real yearly files --> 265 <file_group id="2y" output_freq="2y" output_level="10" enabled=".TRUE."/> <!-- real 2y files --> 266 <file_group id="5y" output_freq="5y" output_level="10" enabled=".TRUE."/> <!-- real 5y files --> 267 <file_group id="10y" output_freq="10y" output_level="10" enabled=".TRUE."/> <!-- real 10y files --> 268 269 </file_definition> 270 271 <!-- 272 ============================================================================================================ 273 = grid definition = = DO NOT CHANGE = 274 ============================================================================================================ 275 --> 276 277 <axis_definition> 278 <axis id="deptht" long_name="Vertical T levels" unit="m" positive="down" /> 279 <axis id="depthu" long_name="Vertical U levels" unit="m" positive="down" /> 280 <axis id="depthv" long_name="Vertical V levels" unit="m" positive="down" /> 281 <axis id="depthw" long_name="Vertical W levels" unit="m" positive="down" /> 282 <axis id="nfloat" long_name="Float number" unit="-" /> 283 <axis id="icbcla" long_name="Iceberg class" unit="-" /> 284 </axis_definition> 285 286 <domain_definition src="./domain_def.xml"/> 287 288 <grid_definition> 289 <grid id="grid_T_2D" domain_ref="grid_T"/> 290 <grid id="grid_T_3D" domain_ref="grid_T" axis_ref="deptht"/> 291 <grid id="grid_U_2D" domain_ref="grid_U"/> 292 <grid id="grid_U_3D" domain_ref="grid_U" axis_ref="depthu"/> 293 <grid id="grid_V_2D" domain_ref="grid_V"/> 294 <grid id="grid_V_3D" domain_ref="grid_V" axis_ref="depthv"/> 295 <grid id="grid_W_2D" domain_ref="grid_W"/> 296 <grid id="grid_W_3D" domain_ref="grid_W" axis_ref="depthw"/> 297 </grid_definition> 298 </context> 155 299 156 300 <context id="xios"> -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/NST_SRC/agrif2model.F90
r3680 r6204 1 1 #if defined key_agrif 2 3 !! NEMO/NST 3.3, NEMO Consortium (2010)4 5 6 7 8 9 10 11 2 !!---------------------------------------------------------------------- 3 !! NEMO/NST 3.6 , NEMO Consortium (2010) 4 !! $Id$ 5 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 6 !!---------------------------------------------------------------------- 7 SUBROUTINE Agrif2Model 8 !!--------------------------------------------- 9 !! *** ROUTINE Agrif2Model *** 10 !!--------------------------------------------- 11 END SUBROUTINE Agrif2model 12 12 13 14 15 16 17 USE Agrif_Types18 13 SUBROUTINE Agrif_Set_numberofcells(Agrif_Gr) 14 !!--------------------------------------------- 15 !! *** ROUTINE Agrif_Set_numberofcells *** 16 !!--------------------------------------------- 17 USE Agrif_Grids 18 IMPLICIT NONE 19 19 20 Type(Agrif_Grid), Pointer:: Agrif_Gr20 TYPE(Agrif_Grid), POINTER :: Agrif_Gr 21 21 22 IF ( associated(Agrif_Curgrid) )THEN22 IF ( ASSOCIATED(Agrif_Curgrid) )THEN 23 23 #include "SetNumberofcells.h" 24 24 ENDIF 25 25 26 26 END SUBROUTINE Agrif_Set_numberofcells 27 27 28 29 30 31 32 USE Agrif_Types33 28 SUBROUTINE Agrif_Get_numberofcells(Agrif_Gr) 29 !!--------------------------------------------- 30 !! *** ROUTINE Agrif_Get_numberofcells *** 31 !!--------------------------------------------- 32 USE Agrif_Grids 33 IMPLICIT NONE 34 34 35 Type(Agrif_Grid), Pointer:: Agrif_Gr35 TYPE(Agrif_Grid), POINTER :: Agrif_Gr 36 36 37 IF ( ASSOCIATED(Agrif_Curgrid) ) THEN 37 38 #include "GetNumberofcells.h" 39 ENDIF 38 40 39 41 END SUBROUTINE Agrif_Get_numberofcells 40 42 41 42 43 44 45 USE Agrif_Types43 SUBROUTINE Agrif_Allocationcalls(Agrif_Gr) 44 !!--------------------------------------------- 45 !! *** ROUTINE Agrif_Allocationscalls *** 46 !!--------------------------------------------- 47 USE Agrif_Grids 46 48 #include "include_use_Alloc_agrif.h" 47 49 IMPLICIT NONE 48 50 49 Type(Agrif_Grid), Pointer:: Agrif_Gr51 TYPE(Agrif_Grid), POINTER :: Agrif_Gr 50 52 51 53 #include "allocations_calls_agrif.h" 52 54 53 55 END SUBROUTINE Agrif_Allocationcalls 54 56 55 56 57 58 59 60 57 SUBROUTINE Agrif_probdim_modtype_def() 58 !!--------------------------------------------- 59 !! *** ROUTINE Agrif_probdim_modtype_def *** 60 !!--------------------------------------------- 61 USE Agrif_Types 62 IMPLICIT NONE 61 63 62 64 #include "modtype_agrif.h" … … 64 66 #include "keys_agrif.h" 65 67 66 Return68 RETURN 67 69 68 70 END SUBROUTINE Agrif_probdim_modtype_def 69 71 70 SUBROUTINE Agrif_clustering_def() 71 !!--------------------------------------------- 72 !! *** ROUTINE Agrif_clustering_def *** 73 !!--------------------------------------------- 74 Use Agrif_Types 75 IMPLICIT NONE 72 SUBROUTINE Agrif_clustering_def() 73 !!--------------------------------------------- 74 !! *** ROUTINE Agrif_clustering_def *** 75 !!--------------------------------------------- 76 IMPLICIT NONE 76 77 77 Return78 RETURN 78 79 79 80 END SUBROUTINE Agrif_clustering_def 80 81 81 SUBROUTINE Agrif_comm_def(modelcomm) 82 83 !!--------------------------------------------- 84 !! *** ROUTINE Agrif_clustering_def *** 85 !!--------------------------------------------- 86 Use Agrif_Types 87 Use lib_mpp 88 89 IMPLICIT NONE 90 91 INTEGER :: modelcomm 92 93 #if defined key_mpp_mpi 94 modelcomm = mpi_comm_opa 82 #else 83 SUBROUTINE Agrif2Model 84 !!--------------------------------------------- 85 !! *** ROUTINE Agrif2Model *** 86 !!--------------------------------------------- 87 WRITE(*,*) 'Impossible to bet here' 88 END SUBROUTINE Agrif2model 95 89 #endif 96 Return97 98 END SUBROUTINE Agrif_comm_def99 #else100 SUBROUTINE Agrif2Model101 !!---------------------------------------------102 !! *** ROUTINE Agrif2Model ***103 !!---------------------------------------------104 WRITE(*,*) 'Impossible to bet here'105 END SUBROUTINE Agrif2model106 #endif -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/NST_SRC/agrif_lim2_interp.F90
r3680 r6204 9 9 !! 3.4 ! 09-2012 (R. Benshila, C. Herbaut) update and EVP 10 10 !!---------------------------------------------------------------------- 11 #if defined key_agrif && defined key_lim2 11 #if defined key_agrif && defined key_lim2 12 12 !!---------------------------------------------------------------------- 13 13 !! 'key_lim2' : LIM 2.0 sea-ice model … … 41 41 PUBLIC interp_adv_ice 42 42 43 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, PRIVATE :: uice_agr, vice_agr 44 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, PRIVATE :: tabice_agr 45 46 43 47 !!---------------------------------------------------------------------- 44 48 !! NEMO/NST 3.4 , NEMO Consortium (2012) … … 65 69 u_ice_nst(:,:) = 0. 66 70 v_ice_nst(:,:) = 0. 67 CALL Agrif_Bc_variable( u_ice_ nst, u_ice_id ,procname=interp_u_ice, calledweight=1. )68 CALL Agrif_Bc_variable( v_ice_ nst, v_ice_id ,procname=interp_v_ice, calledweight=1. )71 CALL Agrif_Bc_variable( u_ice_id ,procname=interp_u_ice, calledweight=1. ) 72 CALL Agrif_Bc_variable( v_ice_id ,procname=interp_v_ice, calledweight=1. ) 69 73 Agrif_SpecialValue=0. 70 74 Agrif_UseSpecialValue = .FALSE. … … 138 142 !! we are in inside a new parent ice time step 139 143 !!----------------------------------------------------------------------- 140 REAL(wp), DIMENSION(jpi,jpj) :: zuice, zvice141 144 INTEGER :: ji,jj 142 145 REAL(wp) :: zrhox, zrhoy … … 155 158 Agrif_SpecialValue=-9999. 156 159 Agrif_UseSpecialValue = .TRUE. 157 zuice = 0. 158 zvice = 0. 159 CALL Agrif_Bc_variable(zuice,u_ice_id,procname=interp_u_ice, calledweight=1.) 160 CALL Agrif_Bc_variable(zvice,v_ice_id,procname=interp_v_ice, calledweight=1.) 160 IF( .NOT. ALLOCATED(uice_agr) )THEN 161 ALLOCATE(uice_agr(jpi,jpj), vice_agr(jpi,jpj)) 162 ENDIF 163 uice_agr = 0. 164 vice_agr = 0. 165 CALL Agrif_Bc_variable(u_ice_id,procname=interp_u_ice, calledweight=1.) 166 CALL Agrif_Bc_variable(v_ice_id,procname=interp_v_ice, calledweight=1.) 161 167 Agrif_SpecialValue=0. 162 168 Agrif_UseSpecialValue = .FALSE. 163 169 ! 164 170 zrhox = agrif_rhox() ; zrhoy = agrif_rhoy() 165 zuice(:,:) = zuice(:,:)/(zrhoy*e2u(:,:))*umask(:,:,1)166 zvice(:,:) = zvice(:,:)/(zrhox*e1v(:,:))*vmask(:,:,1)171 uice_agr(:,:) = uice_agr(:,:)/(zrhoy*e2u(:,:))*umask(:,:,1) 172 vice_agr(:,:) = vice_agr(:,:)/(zrhox*e1v(:,:))*vmask(:,:,1) 167 173 ! fill boundaries 168 174 DO jj = 1, jpj 169 175 DO ji = 1, 2 170 u_ice_oe(ji, jj,2) = zuice(ji ,jj)171 u_ice_oe(ji+2,jj,2) = zuice(nlci+ji-3,jj)176 u_ice_oe(ji, jj,2) = uice_agr(ji ,jj) 177 u_ice_oe(ji+2,jj,2) = uice_agr(nlci+ji-3,jj) 172 178 END DO 173 179 END DO 174 180 DO jj = 1, jpj 175 v_ice_oe(2,jj,2) = zvice(2 ,jj)176 v_ice_oe(4,jj,2) = zvice(nlci-1,jj)181 v_ice_oe(2,jj,2) = vice_agr(2 ,jj) 182 v_ice_oe(4,jj,2) = vice_agr(nlci-1,jj) 177 183 END DO 178 184 DO ji = 1, jpi 179 u_ice_sn(ji,2,2) = zuice(ji,2 )180 u_ice_sn(ji,4,2) = zuice(ji,nlcj-1)185 u_ice_sn(ji,2,2) = uice_agr(ji,2 ) 186 u_ice_sn(ji,4,2) = uice_agr(ji,nlcj-1) 181 187 END DO 182 188 DO jj = 1, 2 183 189 DO ji = 1, jpi 184 v_ice_sn(ji,jj ,2) = zvice(ji,jj )185 v_ice_sn(ji,jj+2,2) = zvice(ji,nlcj+jj-3)190 v_ice_sn(ji,jj ,2) = vice_agr(ji,jj ) 191 v_ice_sn(ji,jj+2,2) = vice_agr(ji,nlcj+jj-3) 186 192 END DO 187 193 END DO … … 334 340 !! we are in inside a new parent ice time step 335 341 !!----------------------------------------------------------------------- 336 REAL(wp), DIMENSION(jpi,jpj,7) :: ztab337 342 INTEGER :: ji,jj,jn 338 343 !!----------------------------------------------------------------------- … … 345 350 adv_ice_sn(:,:,:,1) = adv_ice_sn(:,:,:,2) 346 351 ! interpolation of boundaries 347 ztab(:,:,:) = 0. 352 IF(.NOT.ALLOCATED(tabice_agr))THEN 353 ALLOCATE(tabice_agr(jpi,jpj,7)) 354 ENDIF 355 tabice_agr(:,:,:) = 0. 348 356 Agrif_SpecialValue=-9999. 349 357 Agrif_UseSpecialValue = .TRUE. 350 CALL Agrif_Bc_variable( ztab,adv_ice_id ,procname=interp_adv_ice,calledweight=1. )358 CALL Agrif_Bc_variable( adv_ice_id ,procname=interp_adv_ice,calledweight=1. ) 351 359 Agrif_SpecialValue=0. 352 360 Agrif_UseSpecialValue = .FALSE. … … 356 364 DO jj = 1, jpj 357 365 DO ji=1,2 358 adv_ice_oe(ji ,jj,jn,2) = ztab(ji ,jj,jn)359 adv_ice_oe(ji+2,jj,jn,2) = ztab(nlci-2+ji,jj,jn)366 adv_ice_oe(ji ,jj,jn,2) = tabice_agr(ji ,jj,jn) 367 adv_ice_oe(ji+2,jj,jn,2) = tabice_agr(nlci-2+ji,jj,jn) 360 368 END DO 361 369 END DO … … 365 373 Do jj =1,2 366 374 DO ji = 1, jpi 367 adv_ice_sn(ji,jj ,jn,2) = ztab(ji,jj ,jn)368 adv_ice_sn(ji,jj+2,jn,2) = ztab(ji,nlcj-2+jj,jn)375 adv_ice_sn(ji,jj ,jn,2) = tabice_agr(ji,jj ,jn) 376 adv_ice_sn(ji,jj+2,jn,2) = tabice_agr(ji,nlcj-2+jj,jn) 369 377 END DO 370 378 END DO … … 384 392 INTEGER :: ji,jj,jn 385 393 REAL(wp) :: zalpha 386 REAL(wp), DIMENSION(jpi,jpj,7) :: ztab394 REAL(wp), DIMENSION(jpi,jpj,7) :: tabice_agr 387 395 !!----------------------------------------------------------------------- 388 396 ! … … 391 399 zalpha = REAL(lim_nbstep,wp) / (Agrif_Rhot()*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc)) 392 400 ! 393 ztab(:,:,:) = 0.e0401 tabice_agr(:,:,:) = 0.e0 394 402 DO jn =1,7 395 403 DO jj =1,2 396 404 DO ji = 1, jpi 397 ztab(ji,jj ,jn) = (1-zalpha)*adv_ice_sn(ji,jj ,jn,1) + zalpha*adv_ice_sn(ji,jj ,jn,2)398 ztab(ji,nlcj-2+jj ,jn) = (1-zalpha)*adv_ice_sn(ji,jj+2,jn,1) + zalpha*adv_ice_sn(ji,jj+2,jn,2)405 tabice_agr(ji,jj ,jn) = (1-zalpha)*adv_ice_sn(ji,jj ,jn,1) + zalpha*adv_ice_sn(ji,jj ,jn,2) 406 tabice_agr(ji,nlcj-2+jj ,jn) = (1-zalpha)*adv_ice_sn(ji,jj+2,jn,1) + zalpha*adv_ice_sn(ji,jj+2,jn,2) 399 407 END DO 400 408 END DO … … 404 412 DO jj = 1, jpj 405 413 DO ji=1,2 406 ztab(ji ,jj,jn) = (1-zalpha)*adv_ice_oe(ji ,jj,jn,1) + zalpha*adv_ice_oe(ji ,jj,jn,2)407 ztab(nlci-2+ji,jj,jn) = (1-zalpha)*adv_ice_oe(ji+2,jj,jn,1) + zalpha*adv_ice_oe(ji+2,jj,jn,2)414 tabice_agr(ji ,jj,jn) = (1-zalpha)*adv_ice_oe(ji ,jj,jn,1) + zalpha*adv_ice_oe(ji ,jj,jn,2) 415 tabice_agr(nlci-2+ji,jj,jn) = (1-zalpha)*adv_ice_oe(ji+2,jj,jn,1) + zalpha*adv_ice_oe(ji+2,jj,jn,2) 408 416 END DO 409 417 END DO 410 418 END DO 411 419 ! 412 CALL parcoursT( ztab(:,:, 1), frld )413 CALL parcoursT( ztab(:,:, 2), hicif )414 CALL parcoursT( ztab(:,:, 3), hsnif )415 CALL parcoursT( ztab(:,:, 4), tbif(:,:,1) )416 CALL parcoursT( ztab(:,:, 5), tbif(:,:,2) )417 CALL parcoursT( ztab(:,:, 6), tbif(:,:,3) )418 CALL parcoursT( ztab(:,:, 7), qstoif )420 CALL parcoursT( tabice_agr(:,:, 1), frld ) 421 CALL parcoursT( tabice_agr(:,:, 2), hicif ) 422 CALL parcoursT( tabice_agr(:,:, 3), hsnif ) 423 CALL parcoursT( tabice_agr(:,:, 4), tbif(:,:,1) ) 424 CALL parcoursT( tabice_agr(:,:, 5), tbif(:,:,2) ) 425 CALL parcoursT( tabice_agr(:,:, 6), tbif(:,:,3) ) 426 CALL parcoursT( tabice_agr(:,:, 7), qstoif ) 419 427 ! 420 428 END SUBROUTINE agrif_trp_lim2 … … 499 507 500 508 501 SUBROUTINE interp_u_ice( tabres, i1, i2, j1, j2 )509 SUBROUTINE interp_u_ice( tabres, i1, i2, j1, j2, before ) 502 510 !!----------------------------------------------------------------------- 503 511 !! *** ROUTINE interp_u_ice *** … … 505 513 INTEGER, INTENT(in) :: i1, i2, j1, j2 506 514 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 515 LOGICAL, INTENT(in) :: before 507 516 !! 508 517 INTEGER :: ji,jj … … 510 519 ! 511 520 #if defined key_lim2_vp 512 DO jj=MAX(j1,2),j2 513 DO ji=MAX(i1,2),i2 514 IF( tmu(ji,jj) == 0. ) THEN 515 tabres(ji,jj) = -9999. 516 ELSE 517 tabres(ji,jj) = e2f(ji-1,jj-1) * u_ice(ji,jj) 518 ENDIF 519 END DO 520 END DO 521 IF( before ) THEN 522 DO jj=MAX(j1,2),j2 523 DO ji=MAX(i1,2),i2 524 IF( tmu(ji,jj) == 0. ) THEN 525 tabres(ji,jj) = -9999. 526 ELSE 527 tabres(ji,jj) = e2f(ji-1,jj-1) * u_ice(ji,jj) 528 ENDIF 529 END DO 530 END DO 531 ENDIF 521 532 #else 522 DO jj= j1, j2 523 DO ji= i1, i2 524 IF( umask(ji,jj,1) == 0. ) THEN 525 tabres(ji,jj) = -9999. 526 ELSE 527 tabres(ji,jj) = e2u(ji,jj) * u_ice(ji,jj) 528 ENDIF 529 END DO 530 END DO 533 IF( before ) THEN 534 DO jj= j1, j2 535 DO ji= i1, i2 536 IF( umask(ji,jj,1) == 0. ) THEN 537 tabres(ji,jj) = -9999. 538 ELSE 539 tabres(ji,jj) = e2u(ji,jj) * u_ice(ji,jj) 540 ENDIF 541 END DO 542 END DO 543 ENDIF 531 544 #endif 532 545 END SUBROUTINE interp_u_ice 533 546 534 547 535 SUBROUTINE interp_v_ice( tabres, i1, i2, j1, j2 )548 SUBROUTINE interp_v_ice( tabres, i1, i2, j1, j2, before ) 536 549 !!----------------------------------------------------------------------- 537 550 !! *** ROUTINE interp_v_ice *** … … 539 552 INTEGER, INTENT(in) :: i1, i2, j1, j2 540 553 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 554 LOGICAL, INTENT(in) :: before 541 555 !! 542 556 INTEGER :: ji, jj … … 544 558 ! 545 559 #if defined key_lim2_vp 546 DO jj=MAX(j1,2),j2 547 DO ji=MAX(i1,2),i2 548 IF( tmu(ji,jj) == 0. ) THEN 549 tabres(ji,jj) = -9999. 550 ELSE 551 tabres(ji,jj) = e1f(ji-1,jj-1) * v_ice(ji,jj) 552 ENDIF 553 END DO 554 END DO 560 IF( before ) THEN 561 DO jj=MAX(j1,2),j2 562 DO ji=MAX(i1,2),i2 563 IF( tmu(ji,jj) == 0. ) THEN 564 tabres(ji,jj) = -9999. 565 ELSE 566 tabres(ji,jj) = e1f(ji-1,jj-1) * v_ice(ji,jj) 567 ENDIF 568 END DO 569 END DO 570 ENDIF 555 571 #else 556 DO jj= j1 ,j2 557 DO ji = i1, i2 558 IF( vmask(ji,jj,1) == 0. ) THEN 559 tabres(ji,jj) = -9999. 560 ELSE 561 tabres(ji,jj) = e1v(ji,jj) * v_ice(ji,jj) 562 ENDIF 563 END DO 564 END DO 572 IF( before ) THEN 573 DO jj= j1 ,j2 574 DO ji = i1, i2 575 IF( vmask(ji,jj,1) == 0. ) THEN 576 tabres(ji,jj) = -9999. 577 ELSE 578 tabres(ji,jj) = e1v(ji,jj) * v_ice(ji,jj) 579 ENDIF 580 END DO 581 END DO 582 ENDIF 565 583 #endif 566 584 END SUBROUTINE interp_v_ice 567 585 568 586 569 SUBROUTINE interp_adv_ice( tabres, i1, i2, j1, j2 )587 SUBROUTINE interp_adv_ice( tabres, i1, i2, j1, j2, before ) 570 588 !!----------------------------------------------------------------------- 571 589 !! *** ROUTINE interp_adv_ice *** … … 577 595 INTEGER, INTENT(in) :: i1, i2, j1, j2 578 596 REAL(wp), DIMENSION(i1:i2,j1:j2,7), INTENT(inout) :: tabres 597 LOGICAL, INTENT(in) :: before 579 598 !! 580 599 INTEGER :: ji, jj, jk 581 600 !!----------------------------------------------------------------------- 582 601 ! 583 DO jj=j1,j2 584 DO ji=i1,i2 585 IF( tms(ji,jj) == 0. ) THEN 586 tabres(ji,jj,:) = -9999. 587 ELSE 588 tabres(ji,jj, 1) = frld (ji,jj) 589 tabres(ji,jj, 2) = hicif (ji,jj) 590 tabres(ji,jj, 3) = hsnif (ji,jj) 591 tabres(ji,jj, 4) = tbif (ji,jj,1) 592 tabres(ji,jj, 5) = tbif (ji,jj,2) 593 tabres(ji,jj, 6) = tbif (ji,jj,3) 594 tabres(ji,jj, 7) = qstoif(ji,jj) 595 ENDIF 596 END DO 597 END DO 602 IF( before ) THEN 603 DO jj=j1,j2 604 DO ji=i1,i2 605 IF( tms(ji,jj) == 0. ) THEN 606 tabres(ji,jj,:) = -9999. 607 ELSE 608 tabres(ji,jj, 1) = frld (ji,jj) 609 tabres(ji,jj, 2) = hicif (ji,jj) 610 tabres(ji,jj, 3) = hsnif (ji,jj) 611 tabres(ji,jj, 4) = tbif (ji,jj,1) 612 tabres(ji,jj, 5) = tbif (ji,jj,2) 613 tabres(ji,jj, 6) = tbif (ji,jj,3) 614 tabres(ji,jj, 7) = qstoif(ji,jj) 615 ENDIF 616 END DO 617 END DO 618 ENDIF 598 619 ! 599 620 END SUBROUTINE interp_adv_ice -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/NST_SRC/agrif_lim2_update.F90
r3680 r6204 52 52 INTEGER, INTENT(in) :: kt 53 53 !! 54 REAL(wp), DIMENSION(jpi,jpj) :: zvel55 REAL(wp), DIMENSION(jpi,jpj,7):: zadv56 54 !!---------------------------------------------------------------------- 57 55 ! … … 60 58 Agrif_UseSpecialValueInUpdate = .TRUE. 61 59 Agrif_SpecialValueFineGrid = 0. 62 63 60 # if defined TWO_WAY 64 61 IF( MOD(nbcline,nbclineupdate) == 0) THEN 65 CALL Agrif_Update_Variable( zadv ,adv_ice_id , procname = update_adv_ice )66 CALL Agrif_Update_Variable( zvel ,u_ice_id , procname = update_u_ice )67 CALL Agrif_Update_Variable( zvel ,v_ice_id , procname = update_v_ice )68 ELSE 69 CALL Agrif_Update_Variable( zadv ,adv_ice_id , locupdate=(/0,2/), procname = update_adv_ice )70 CALL Agrif_Update_Variable( zvel ,u_ice_id , locupdate=(/0,1/), procname = update_u_ice )71 CALL Agrif_Update_Variable( zvel ,v_ice_id , locupdate=(/0,1/), procname = update_v_ice )62 CALL Agrif_Update_Variable( adv_ice_id , procname = update_adv_ice ) 63 CALL Agrif_Update_Variable( u_ice_id , procname = update_u_ice ) 64 CALL Agrif_Update_Variable( v_ice_id , procname = update_v_ice ) 65 ELSE 66 CALL Agrif_Update_Variable( adv_ice_id , locupdate=(/0,2/), procname = update_adv_ice ) 67 CALL Agrif_Update_Variable( u_ice_id , locupdate=(/0,1/), procname = update_u_ice ) 68 CALL Agrif_Update_Variable( v_ice_id , locupdate=(/0,1/), procname = update_v_ice ) 72 69 ENDIF 73 70 # endif -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90
r4491 r6204 12 12 USE par_oce ! ocean parameters 13 13 USE dom_oce ! domain parameters 14 14 15 15 IMPLICIT NONE 16 16 PRIVATE … … 19 19 20 20 ! !!* Namelist namagrif: AGRIF parameters 21 LOGICAL , PUBLIC :: ln_spc_dyn !: 22 INTEGER , PUBLIC :: nn_cln_update !: update frequency 23 REAL(wp), PUBLIC :: rn_sponge_tra !: sponge coeff. for tracers 24 REAL(wp), PUBLIC :: rn_sponge_dyn !: sponge coeff. for dynamics 21 LOGICAL , PUBLIC :: ln_spc_dyn = .FALSE. !: 22 INTEGER , PUBLIC :: nn_cln_update = 3 !: update frequency 23 INTEGER , PUBLIC, PARAMETER :: nn_sponge_len = 2 !: Sponge width (in number of parent grid points) 24 REAL(wp), PUBLIC :: rn_sponge_tra = 2800. !: sponge coeff. for tracers 25 REAL(wp), PUBLIC :: rn_sponge_dyn = 2800. !: sponge coeff. for dynamics 26 LOGICAL , PUBLIC :: ln_chk_bathy = .FALSE. !: check of parent bathymetry 25 27 26 28 ! !!! OLD namelist names … … 30 32 REAL(wp), PUBLIC :: visc_dyn !: sponge coeff. for dynamics 31 33 32 LOGICAL , PUBLIC :: spongedoneT = .FALSE. !: tracer sponge layer indicator 33 LOGICAL , PUBLIC :: spongedoneU = .FALSE. !: dynamics sponge layer indicator 34 LOGICAL , PUBLIC :: lk_agrif_fstep = .TRUE. !: if true: first step 34 LOGICAL , PUBLIC :: spongedoneT = .FALSE. !: tracer sponge layer indicator 35 LOGICAL , PUBLIC :: spongedoneU = .FALSE. !: dynamics sponge layer indicator 36 LOGICAL , PUBLIC :: lk_agrif_fstep = .TRUE. !: if true: first step 37 LOGICAL , PUBLIC :: lk_agrif_doupd = .TRUE. !: if true: send update from current grid 38 LOGICAL , PUBLIC :: lk_agrif_debug = .FALSE. !: if true: print debugging info 35 39 36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: spe1ur , spe2vr , spbtr2 !: ??? 37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: spe1ur2, spe2vr2, spbtr3 !: ??? 38 39 INTEGER :: tsn_id,tsb_id,tsa_id 40 INTEGER :: un_id, vn_id, ua_id, va_id 41 INTEGER :: e1u_id, e2v_id, sshn_id, gcb_id 42 INTEGER :: trn_id, trb_id, tra_id 43 INTEGER :: unb_id, vnb_id, ub2b_id, vb2b_id 40 LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_tsn 41 # if defined key_top 42 LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_trn 43 # endif 44 LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_u 45 LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tabspongedone_v 46 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fsaht_spu, fsaht_spv !: sponge diffusivities 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fsahm_spt, fsahm_spf !: sponge viscosities 48 49 ! Barotropic arrays used to store open boundary data during 50 ! time-splitting loop: 51 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: ubdy_w, vbdy_w, hbdy_w 52 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: ubdy_e, vbdy_e, hbdy_e 53 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: ubdy_n, vbdy_n, hbdy_n 54 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: ubdy_s, vbdy_s, hbdy_s 55 56 INTEGER :: tsn_id ! AGRIF profile for tracers interpolation and update 57 INTEGER :: un_interp_id, vn_interp_id ! AGRIF profiles for interpolations 58 INTEGER :: un_update_id, vn_update_id ! AGRIF profiles for udpates 59 INTEGER :: tsn_sponge_id, un_sponge_id, vn_sponge_id ! AGRIF profiles for sponge layers 60 # if defined key_top 61 INTEGER :: trn_id, trn_sponge_id 62 # endif 63 INTEGER :: unb_id, vnb_id, ub2b_interp_id, vb2b_interp_id 64 INTEGER :: ub2b_update_id, vb2b_update_id 65 INTEGER :: e3t_id, e1u_id, e2v_id, sshn_id 66 INTEGER :: scales_t_id 67 # if defined key_zdftke 68 INTEGER :: avt_id, avm_id, en_id 69 # endif 70 INTEGER :: umsk_id, vmsk_id 71 INTEGER :: kindic_agr 44 72 45 73 !!---------------------------------------------------------------------- … … 54 82 !! *** FUNCTION agrif_oce_alloc *** 55 83 !!---------------------------------------------------------------------- 56 ALLOCATE( spe1ur (jpi,jpj) , spe2vr (jpi,jpj) , spbtr2(jpi,jpj) , & 57 & spe1ur2(jpi,jpj) , spe2vr2(jpi,jpj) , spbtr3(jpi,jpj) , STAT = agrif_oce_alloc ) 84 INTEGER, DIMENSION(2) :: ierr 85 !!---------------------------------------------------------------------- 86 ierr(:) = 0 87 ! 88 ALLOCATE( fsaht_spu(jpi,jpj), fsaht_spv(jpi,jpj), & 89 & fsahm_spt(jpi,jpj), fsahm_spf(jpi,jpj), & 90 & tabspongedone_tsn(jpi,jpj), & 91 # if defined key_top 92 & tabspongedone_trn(jpi,jpj), & 93 # endif 94 & tabspongedone_u (jpi,jpj), & 95 & tabspongedone_v (jpi,jpj), STAT = ierr(1) ) 96 97 ALLOCATE( ubdy_w(jpj), vbdy_w(jpj), hbdy_w(jpj), & 98 & ubdy_e(jpj), vbdy_e(jpj), hbdy_e(jpj), & 99 & ubdy_n(jpi), vbdy_n(jpi), hbdy_n(jpi), & 100 & ubdy_s(jpi), vbdy_s(jpi), hbdy_s(jpi), STAT = ierr(2) ) 101 102 agrif_oce_alloc = MAXVAL(ierr) 103 ! 58 104 END FUNCTION agrif_oce_alloc 59 105 -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
r4486 r6204 7 7 !! - ! 2005-11 (XXX) 8 8 !! 3.2 ! 2009-04 (R. Benshila) 9 !! 3.6 ! 2014-09 (R. Benshila) 9 10 !!---------------------------------------------------------------------- 10 11 #if defined key_agrif && ! defined key_offline … … 29 30 USE wrk_nemo 30 31 USE dynspg_oce 31 32 USE zdf_oce 33 32 34 IMPLICIT NONE 33 35 PRIVATE 34 36 35 ! Barotropic arrays used to store open boundary data during 36 ! time-splitting loop: 37 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: ubdy_w, vbdy_w, hbdy_w 38 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: ubdy_e, vbdy_e, hbdy_e 39 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: ubdy_n, vbdy_n, hbdy_n 40 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: ubdy_s, vbdy_s, hbdy_s 41 37 INTEGER :: bdy_tinterp = 0 38 42 39 PUBLIC Agrif_tra, Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ssh_ts, Agrif_dta_ts 43 PUBLIC interpu, interpv, interpunb, interpvnb, interpsshn 40 PUBLIC interpun, interpvn, interpun2d, interpvn2d 41 PUBLIC interptsn, interpsshn 42 PUBLIC interpunb, interpvnb, interpub2b, interpvb2b 43 PUBLIC interpe3t, interpumsk, interpvmsk 44 # if defined key_zdftke 45 PUBLIC Agrif_tke, interpavm 46 # endif 44 47 45 48 # include "domzgr_substitute.h90" 46 49 # include "vectopt_loop_substitute.h90" 47 50 !!---------------------------------------------------------------------- 48 !! NEMO/NST 3. 3, NEMO Consortium (2010)51 !! NEMO/NST 3.6 , NEMO Consortium (2010) 49 52 !! $Id$ 50 53 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 51 54 !!---------------------------------------------------------------------- 52 55 53 54 56 CONTAINS 57 55 58 SUBROUTINE Agrif_tra 56 59 !!---------------------------------------------------------------------- 57 !! *** ROUTINE Agrif_Tra *** 58 !!---------------------------------------------------------------------- 59 !! 60 INTEGER :: ji, jj, jk, jn ! dummy loop indices 61 REAL(wp) :: zrhox , alpha1, alpha2, alpha3 62 REAL(wp) :: alpha4, alpha5, alpha6, alpha7 63 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztsa 60 !! *** ROUTINE Agrif_tra *** 64 61 !!---------------------------------------------------------------------- 65 62 ! 66 63 IF( Agrif_Root() ) RETURN 67 68 CALL wrk_alloc( jpi, jpj, jpk, jpts, ztsa )69 64 70 65 Agrif_SpecialValue = 0.e0 71 66 Agrif_UseSpecialValue = .TRUE. 72 ztsa(:,:,:,:) = 0.e0 73 74 CALL Agrif_Bc_variable( ztsa, tsn_id, procname=interptsn ) 67 68 CALL Agrif_Bc_variable( tsn_id, procname=interptsn ) 75 69 Agrif_UseSpecialValue = .FALSE. 76 77 zrhox = Agrif_Rhox()78 79 alpha1 = ( zrhox - 1. ) * 0.580 alpha2 = 1. - alpha181 82 alpha3 = ( zrhox - 1. ) / ( zrhox + 1. )83 alpha4 = 1. - alpha384 85 alpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )86 alpha7 = - ( zrhox - 1. ) / ( zrhox + 3. )87 alpha5 = 1. - alpha6 - alpha788 89 IF( nbondi == 1 .OR. nbondi == 2 ) THEN90 91 DO jn = 1, jpts92 tsa(nlci,:,:,jn) = alpha1 * ztsa(nlci,:,:,jn) + alpha2 * ztsa(nlci-1,:,:,jn)93 DO jk = 1, jpkm194 DO jj = 1, jpj95 IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN96 tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk)97 ELSE98 tsa(nlci-1,jj,jk,jn)=(alpha4*tsa(nlci,jj,jk,jn)+alpha3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk)99 IF( un(nlci-2,jj,jk) > 0.e0 ) THEN100 tsa(nlci-1,jj,jk,jn)=( alpha6*tsa(nlci-2,jj,jk,jn)+alpha5*tsa(nlci,jj,jk,jn) &101 & + alpha7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk)102 ENDIF103 ENDIF104 END DO105 END DO106 ENDDO107 ENDIF108 109 IF( nbondj == 1 .OR. nbondj == 2 ) THEN110 111 DO jn = 1, jpts112 tsa(:,nlcj,:,jn) = alpha1 * ztsa(:,nlcj,:,jn) + alpha2 * ztsa(:,nlcj-1,:,jn)113 DO jk = 1, jpkm1114 DO ji = 1, jpi115 IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN116 tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)117 ELSE118 tsa(ji,nlcj-1,jk,jn)=(alpha4*tsa(ji,nlcj,jk,jn)+alpha3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)119 IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN120 tsa(ji,nlcj-1,jk,jn)=( alpha6*tsa(ji,nlcj-2,jk,jn)+alpha5*tsa(ji,nlcj,jk,jn) &121 & + alpha7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)122 ENDIF123 ENDIF124 END DO125 END DO126 ENDDO127 ENDIF128 129 IF( nbondi == -1 .OR. nbondi == 2 ) THEN130 DO jn = 1, jpts131 tsa(1,:,:,jn) = alpha1 * ztsa(1,:,:,jn) + alpha2 * ztsa(2,:,:,jn)132 DO jk = 1, jpkm1133 DO jj = 1, jpj134 IF( umask(2,jj,jk) == 0.e0 ) THEN135 tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk)136 ELSE137 tsa(2,jj,jk,jn)=(alpha4*tsa(1,jj,jk,jn)+alpha3*tsa(3,jj,jk,jn))*tmask(2,jj,jk)138 IF( un(2,jj,jk) < 0.e0 ) THEN139 tsa(2,jj,jk,jn)=(alpha6*tsa(3,jj,jk,jn)+alpha5*tsa(1,jj,jk,jn)+alpha7*tsa(4,jj,jk,jn))*tmask(2,jj,jk)140 ENDIF141 ENDIF142 END DO143 END DO144 END DO145 ENDIF146 147 IF( nbondj == -1 .OR. nbondj == 2 ) THEN148 DO jn = 1, jpts149 tsa(:,1,:,jn) = alpha1 * ztsa(:,1,:,jn) + alpha2 * ztsa(:,2,:,jn)150 DO jk=1,jpk151 DO ji=1,jpi152 IF( vmask(ji,2,jk) == 0.e0 ) THEN153 tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk)154 ELSE155 tsa(ji,2,jk,jn)=(alpha4*tsa(ji,1,jk,jn)+alpha3*tsa(ji,3,jk,jn))*tmask(ji,2,jk)156 IF( vn(ji,2,jk) < 0.e0 ) THEN157 tsa(ji,2,jk,jn)=(alpha6*tsa(ji,3,jk,jn)+alpha5*tsa(ji,1,jk,jn)+alpha7*tsa(ji,4,jk,jn))*tmask(ji,2,jk)158 ENDIF159 ENDIF160 END DO161 END DO162 ENDDO163 ENDIF164 !165 CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztsa )166 70 ! 167 71 END SUBROUTINE Agrif_tra … … 175 79 INTEGER, INTENT(in) :: kt 176 80 !! 177 INTEGER :: ji,jj,jk 81 INTEGER :: ji,jj,jk, j1,j2, i1,i2 178 82 REAL(wp) :: timeref 179 83 REAL(wp) :: z2dt, znugdt 180 84 REAL(wp) :: zrhox, zrhoy 181 REAL(wp), POINTER, DIMENSION(:,:,:) :: zua, zva 182 REAL(wp), POINTER, DIMENSION(:,:) :: spgv1, spgu1, zua2d, zva2d 85 REAL(wp), POINTER, DIMENSION(:,:) :: spgv1, spgu1 183 86 !!---------------------------------------------------------------------- 184 87 185 88 IF( Agrif_Root() ) RETURN 186 89 187 CALL wrk_alloc( jpi, jpj, spgv1, spgu1, zua2d, zva2d ) 188 CALL wrk_alloc( jpi, jpj, jpk, zua, zva ) 90 CALL wrk_alloc( jpi, jpj, spgv1, spgu1 ) 91 92 Agrif_SpecialValue=0. 93 Agrif_UseSpecialValue = ln_spc_dyn 94 95 CALL Agrif_Bc_variable(un_interp_id,procname=interpun) 96 CALL Agrif_Bc_variable(vn_interp_id,procname=interpvn) 97 98 #if defined key_dynspg_flt 99 CALL Agrif_Bc_variable(e1u_id,calledweight=1., procname=interpun2d) 100 CALL Agrif_Bc_variable(e2v_id,calledweight=1., procname=interpvn2d) 101 #endif 102 103 Agrif_UseSpecialValue = .FALSE. 189 104 190 105 zrhox = Agrif_Rhox() … … 192 107 193 108 timeref = 1. 194 195 109 ! time step: leap-frog 196 110 z2dt = 2. * rdt … … 200 114 znugdt = grav * z2dt 201 115 202 Agrif_SpecialValue=0. 203 Agrif_UseSpecialValue = ln_spc_dyn 204 205 zua = 0. 206 zva = 0. 207 CALL Agrif_Bc_variable(zua,un_id,procname=interpu) 208 CALL Agrif_Bc_variable(zva,vn_id,procname=interpv) 209 zua2d = 0. 210 zva2d = 0. 211 116 ! prevent smoothing in ghost cells 117 i1=1 118 i2=jpi 119 j1=1 120 j2=jpj 121 IF((nbondj == -1).OR.(nbondj == 2)) j1 = 3 122 IF((nbondj == +1).OR.(nbondj == 2)) j2 = nlcj-2 123 IF((nbondi == -1).OR.(nbondi == 2)) i1 = 3 124 IF((nbondi == +1).OR.(nbondi == 2)) i2 = nlci-2 125 126 127 IF((nbondi == -1).OR.(nbondi == 2)) THEN 212 128 #if defined key_dynspg_flt 213 Agrif_SpecialValue=0. 214 Agrif_UseSpecialValue = ln_spc_dyn 215 CALL Agrif_Bc_variable(zua2d,e1u_id,calledweight=1.,procname=interpu2d) 216 CALL Agrif_Bc_variable(zva2d,e2v_id,calledweight=1.,procname=interpv2d) 217 #endif 218 Agrif_UseSpecialValue = .FALSE. 219 220 221 IF((nbondi == -1).OR.(nbondi == 2)) THEN 222 223 #if defined key_dynspg_flt 224 DO jj=1,jpj 225 laplacu(2,jj) = timeref * (zua2d(2,jj)/(zrhoy*e2u(2,jj)))*umask(2,jj,1) 226 END DO 227 #endif 129 DO jk=1,jpkm1 130 DO jj=j1,j2 131 ua(2,jj,jk) = (ua(2,jj,jk) - z2dt * znugdt * laplacu(2,jj))*umask(2,jj,jk) 132 END DO 133 END DO 134 135 spgu(2,:)=0. 228 136 229 137 DO jk=1,jpkm1 230 138 DO jj=1,jpj 231 ua(1:2,jj,jk) = (zua(1:2,jj,jk)/(zrhoy*e2u(1:2,jj))) 232 ua(1:2,jj,jk) = ua(1:2,jj,jk) / fse3u_a(1:2,jj,jk) 233 END DO 234 END DO 235 236 #if defined key_dynspg_flt 237 DO jk=1,jpkm1 238 DO jj=1,jpj 239 ua(2,jj,jk) = (ua(2,jj,jk) - z2dt * znugdt * laplacu(2,jj))*umask(2,jj,jk) 240 END DO 241 END DO 242 243 spgu(2,:)=0. 244 245 DO jk=1,jpkm1 246 DO jj=1,jpj 247 spgu(2,jj)=spgu(2,jj)+fse3u_a(2,jj,jk)*ua(2,jj,jk) 139 spgu(2,jj)=spgu(2,jj)+fse3u(2,jj,jk)*ua(2,jj,jk) 248 140 END DO 249 141 END DO … … 251 143 DO jj=1,jpj 252 144 IF (umask(2,jj,1).NE.0.) THEN 253 spgu(2,jj)=spgu(2,jj) *hur_a(2,jj)145 spgu(2,jj)=spgu(2,jj)/hu(2,jj) 254 146 ENDIF 255 147 END DO … … 259 151 260 152 DO jk=1,jpkm1 261 DO jj= 1,jpj153 DO jj=j1,j2 262 154 ua(2,jj,jk) = 0.25*(ua(1,jj,jk)+2.*ua(2,jj,jk)+ua(3,jj,jk)) 263 155 ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk) … … 269 161 DO jk=1,jpkm1 270 162 DO jj=1,jpj 271 spgu1(2,jj)=spgu1(2,jj)+fse3u _a(2,jj,jk)*ua(2,jj,jk)163 spgu1(2,jj)=spgu1(2,jj)+fse3u(2,jj,jk)*ua(2,jj,jk) 272 164 END DO 273 165 END DO … … 275 167 DO jj=1,jpj 276 168 IF (umask(2,jj,1).NE.0.) THEN 277 spgu1(2,jj)=spgu1(2,jj) *hur_a(2,jj)278 ENDIF 279 END DO 280 281 DO jk=1,jpkm1 282 DO jj= 1,jpj169 spgu1(2,jj)=spgu1(2,jj)/hu(2,jj) 170 ENDIF 171 END DO 172 173 DO jk=1,jpkm1 174 DO jj=j1,j2 283 175 ua(2,jj,jk) = (ua(2,jj,jk)+spgu(2,jj)-spgu1(2,jj))*umask(2,jj,jk) 284 END DO285 END DO286 287 DO jk=1,jpkm1288 DO jj=1,jpj289 va(2,jj,jk) = (zva(2,jj,jk)/(zrhox*e1v(2,jj)))*vmask(2,jj,jk)290 va(2,jj,jk) = va(2,jj,jk) / fse3v_a(2,jj,jk)291 176 END DO 292 177 END DO … … 300 185 END DO 301 186 END DO 302 303 187 DO jj=1,jpj 304 188 spgv1(2,jj)=spgv1(2,jj)*hvr_a(2,jj) 305 189 END DO 306 307 190 DO jk=1,jpkm1 308 191 DO jj=1,jpj … … 316 199 IF((nbondi == 1).OR.(nbondi == 2)) THEN 317 200 #if defined key_dynspg_flt 318 DO jj=1,jpj 319 laplacu(nlci-2,jj) = timeref * (zua2d(nlci-2,jj)/(zrhoy*e2u(nlci-2,jj))) 320 END DO 321 #endif 322 201 DO jk=1,jpkm1 202 DO jj=j1,j2 203 ua(nlci-2,jj,jk) = (ua(nlci-2,jj,jk)- z2dt * znugdt * laplacu(nlci-2,jj))*umask(nlci-2,jj,jk) 204 END DO 205 END DO 206 spgu(nlci-2,:)=0. 323 207 DO jk=1,jpkm1 324 208 DO jj=1,jpj 325 ua(nlci-2:nlci-1,jj,jk) = (zua(nlci-2:nlci-1,jj,jk)/(zrhoy*e2u(nlci-2:nlci-1,jj))) 326 ua(nlci-2:nlci-1,jj,jk) = ua(nlci-2:nlci-1,jj,jk) / fse3u_a(nlci-2:nlci-1,jj,jk) 327 END DO 328 END DO 329 330 #if defined key_dynspg_flt 331 DO jk=1,jpkm1 332 DO jj=1,jpj 333 ua(nlci-2,jj,jk) = (ua(nlci-2,jj,jk)- z2dt * znugdt * laplacu(nlci-2,jj))*umask(nlci-2,jj,jk) 334 END DO 335 END DO 336 337 338 spgu(nlci-2,:)=0. 339 340 do jk=1,jpkm1 341 do jj=1,jpj 342 spgu(nlci-2,jj)=spgu(nlci-2,jj)+fse3u_a(nlci-2,jj,jk)*ua(nlci-2,jj,jk) 343 enddo 344 enddo 345 209 spgu(nlci-2,jj)=spgu(nlci-2,jj)+fse3u(nlci-2,jj,jk)*ua(nlci-2,jj,jk) 210 ENDDO 211 ENDDO 346 212 DO jj=1,jpj 347 213 IF (umask(nlci-2,jj,1).NE.0.) THEN 348 spgu(nlci-2,jj)=spgu(nlci-2,jj) *hur_a(nlci-2,jj)214 spgu(nlci-2,jj)=spgu(nlci-2,jj)/hu(nlci-2,jj) 349 215 ENDIF 350 216 END DO … … 352 218 spgu(nlci-2,:) = ua_b(nlci-2,:) 353 219 #endif 354 220 DO jk=1,jpkm1 221 DO jj=j1,j2 222 ua(nlci-2,jj,jk) = 0.25*(ua(nlci-3,jj,jk)+2.*ua(nlci-2,jj,jk)+ua(nlci-1,jj,jk)) 223 224 ua(nlci-2,jj,jk) = ua(nlci-2,jj,jk) * umask(nlci-2,jj,jk) 225 226 END DO 227 END DO 228 spgu1(nlci-2,:)=0. 355 229 DO jk=1,jpkm1 356 230 DO jj=1,jpj 357 ua(nlci-2,jj,jk) = 0.25*(ua(nlci-3,jj,jk)+2.*ua(nlci-2,jj,jk)+ua(nlci-1,jj,jk)) 358 359 ua(nlci-2,jj,jk) = ua(nlci-2,jj,jk) * umask(nlci-2,jj,jk) 360 361 END DO 362 END DO 363 364 spgu1(nlci-2,:)=0. 365 366 DO jk=1,jpkm1 367 DO jj=1,jpj 368 spgu1(nlci-2,jj)=spgu1(nlci-2,jj)+fse3u_a(nlci-2,jj,jk)*ua(nlci-2,jj,jk)*umask(nlci-2,jj,jk) 369 END DO 370 END DO 371 231 spgu1(nlci-2,jj)=spgu1(nlci-2,jj)+fse3u(nlci-2,jj,jk)*ua(nlci-2,jj,jk)*umask(nlci-2,jj,jk) 232 END DO 233 END DO 372 234 DO jj=1,jpj 373 235 IF (umask(nlci-2,jj,1).NE.0.) THEN 374 spgu1(nlci-2,jj)=spgu1(nlci-2,jj)*hur_a(nlci-2,jj) 375 ENDIF 376 END DO 377 378 DO jk=1,jpkm1 379 DO jj=1,jpj 236 spgu1(nlci-2,jj)=spgu1(nlci-2,jj)/hu(nlci-2,jj) 237 ENDIF 238 END DO 239 DO jk=1,jpkm1 240 DO jj=j1,j2 380 241 ua(nlci-2,jj,jk) = (ua(nlci-2,jj,jk)+spgu(nlci-2,jj)-spgu1(nlci-2,jj))*umask(nlci-2,jj,jk) 381 END DO382 END DO383 384 DO jk=1,jpkm1385 DO jj=1,jpj-1386 va(nlci-1,jj,jk) = (zva(nlci-1,jj,jk)/(zrhox*e1v(nlci-1,jj)))*vmask(nlci-1,jj,jk)387 va(nlci-1,jj,jk) = va(nlci-1,jj,jk) / fse3v_a(nlci-1,jj,jk)388 242 END DO 389 243 END DO … … 414 268 415 269 #if defined key_dynspg_flt 416 DO ji=1,jpi417 laplacv(ji,2) = timeref * (zva2d(ji,2)/(zrhox*e1v(ji,2)))418 END DO419 #endif420 421 DO jk=1,jpkm1422 DO ji=1,jpi423 va(ji,1:2,jk) = (zva(ji,1:2,jk)/(zrhox*e1v(ji,1:2)))424 va(ji,1:2,jk) = va(ji,1:2,jk) / fse3v_a(ji,1:2,jk)425 END DO426 END DO427 428 #if defined key_dynspg_flt429 270 DO jk=1,jpkm1 430 271 DO ji=1,jpi … … 437 278 DO jk=1,jpkm1 438 279 DO ji=1,jpi 439 spgv(ji,2)=spgv(ji,2)+fse3v _a(ji,2,jk)*va(ji,2,jk)280 spgv(ji,2)=spgv(ji,2)+fse3v(ji,2,jk)*va(ji,2,jk) 440 281 END DO 441 282 END DO … … 443 284 DO ji=1,jpi 444 285 IF (vmask(ji,2,1).NE.0.) THEN 445 spgv(ji,2)=spgv(ji,2) *hvr_a(ji,2)286 spgv(ji,2)=spgv(ji,2)/hv(ji,2) 446 287 ENDIF 447 288 END DO … … 451 292 452 293 DO jk=1,jpkm1 453 DO ji= 1,jpi294 DO ji=i1,i2 454 295 va(ji,2,jk)=0.25*(va(ji,1,jk)+2.*va(ji,2,jk)+va(ji,3,jk)) 455 296 va(ji,2,jk)=va(ji,2,jk)*vmask(ji,2,jk) … … 461 302 DO jk=1,jpkm1 462 303 DO ji=1,jpi 463 spgv1(ji,2)=spgv1(ji,2)+fse3v _a(ji,2,jk)*va(ji,2,jk)*vmask(ji,2,jk)304 spgv1(ji,2)=spgv1(ji,2)+fse3v(ji,2,jk)*va(ji,2,jk)*vmask(ji,2,jk) 464 305 END DO 465 306 END DO … … 467 308 DO ji=1,jpi 468 309 IF (vmask(ji,2,1).NE.0.) THEN 469 spgv1(ji,2)=spgv1(ji,2) *hvr_a(ji,2)310 spgv1(ji,2)=spgv1(ji,2)/hv(ji,2) 470 311 ENDIF 471 312 END DO … … 474 315 DO ji=1,jpi 475 316 va(ji,2,jk) = (va(ji,2,jk)+spgv(ji,2)-spgv1(ji,2))*vmask(ji,2,jk) 476 END DO477 END DO478 479 DO jk=1,jpkm1480 DO ji=1,jpi481 ua(ji,2,jk) = (zua(ji,2,jk)/(zrhoy*e2u(ji,2)))*umask(ji,2,jk)482 ua(ji,2,jk) = ua(ji,2,jk) / fse3u_a(ji,2,jk)483 317 END DO 484 318 END DO … … 508 342 509 343 #if defined key_dynspg_flt 510 DO ji=1,jpi511 laplacv(ji,nlcj-2) = timeref * (zva2d(ji,nlcj-2)/(zrhox*e1v(ji,nlcj-2)))512 END DO513 #endif514 515 DO jk=1,jpkm1516 DO ji=1,jpi517 va(ji,nlcj-2:nlcj-1,jk) = (zva(ji,nlcj-2:nlcj-1,jk)/(zrhox*e1v(ji,nlcj-2:nlcj-1)))518 va(ji,nlcj-2:nlcj-1,jk) = va(ji,nlcj-2:nlcj-1,jk) / fse3v_a(ji,nlcj-2:nlcj-1,jk)519 END DO520 END DO521 522 #if defined key_dynspg_flt523 344 DO jk=1,jpkm1 524 345 DO ji=1,jpi … … 527 348 END DO 528 349 350 529 351 spgv(:,nlcj-2)=0. 530 352 531 353 DO jk=1,jpkm1 532 354 DO ji=1,jpi 533 spgv(ji,nlcj-2)=spgv(ji,nlcj-2)+fse3v _a(ji,nlcj-2,jk)*va(ji,nlcj-2,jk)355 spgv(ji,nlcj-2)=spgv(ji,nlcj-2)+fse3v(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 534 356 END DO 535 357 END DO … … 537 359 DO ji=1,jpi 538 360 IF (vmask(ji,nlcj-2,1).NE.0.) THEN 539 spgv(ji,nlcj-2)=spgv(ji,nlcj-2)*hvr_a(ji,nlcj-2) 540 ENDIF 541 END DO 361 spgv(ji,nlcj-2)=spgv(ji,nlcj-2)/hv(ji,nlcj-2) 362 ENDIF 363 END DO 364 542 365 #else 543 366 spgv(:,nlcj-2)=va_b(:,nlcj-2) … … 545 368 546 369 DO jk=1,jpkm1 547 DO ji= 1,jpi370 DO ji=i1,i2 548 371 va(ji,nlcj-2,jk)=0.25*(va(ji,nlcj-3,jk)+2.*va(ji,nlcj-2,jk)+va(ji,nlcj-1,jk)) 549 372 va(ji,nlcj-2,jk) = va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk) … … 555 378 DO jk=1,jpkm1 556 379 DO ji=1,jpi 557 spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)+fse3v _a(ji,nlcj-2,jk)*va(ji,nlcj-2,jk)380 spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)+fse3v(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 558 381 END DO 559 382 END DO … … 561 384 DO ji=1,jpi 562 385 IF (vmask(ji,nlcj-2,1).NE.0.) THEN 563 spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2) *hvr_a(ji,nlcj-2)386 spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)/hv(ji,nlcj-2) 564 387 ENDIF 565 388 END DO … … 568 391 DO ji=1,jpi 569 392 va(ji,nlcj-2,jk) = (va(ji,nlcj-2,jk)+spgv(ji,nlcj-2)-spgv1(ji,nlcj-2))*vmask(ji,nlcj-2,jk) 570 END DO571 END DO572 573 DO jk=1,jpkm1574 DO ji=1,jpi575 ua(ji,nlcj-1,jk) = (zua(ji,nlcj-1,jk)/(zrhoy*e2u(ji,nlcj-1)))*umask(ji,nlcj-1,jk)576 ua(ji,nlcj-1,jk) = ua(ji,nlcj-1,jk) / fse3u_a(ji,nlcj-1,jk)577 393 END DO 578 394 END DO … … 600 416 ENDIF 601 417 ! 602 CALL wrk_dealloc( jpi, jpj, spgv1, spgu1, zua2d, zva2d ) 603 CALL wrk_dealloc( jpi, jpj, jpk, zua, zva ) 418 CALL wrk_dealloc( jpi, jpj, spgv1, spgu1 ) 604 419 ! 605 420 END SUBROUTINE Agrif_dyn … … 620 435 DO jj=1,jpj 621 436 va_e(2,jj) = vbdy_w(jj) * hvr_e(2,jj) 622 ! Specified fluxes:437 ! Specified fluxes: 623 438 ua_e(2,jj) = ubdy_w(jj) * hur_e(2,jj) 624 ! Characteristics method:625 !alt ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) &626 !alt & - sqrt(grav * hur_e(2,jj)) * (sshn_e(3,jj) - hbdy_w(jj)) )439 ! Characteristics method: 440 !alt ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) & 441 !alt & - sqrt(grav * hur_e(2,jj)) * (sshn_e(3,jj) - hbdy_w(jj)) ) 627 442 END DO 628 443 ENDIF … … 631 446 DO jj=1,jpj 632 447 va_e(nlci-1,jj) = vbdy_e(jj) * hvr_e(nlci-1,jj) 633 ! Specified fluxes:448 ! Specified fluxes: 634 449 ua_e(nlci-2,jj) = ubdy_e(jj) * hur_e(nlci-2,jj) 635 ! Characteristics method:636 !alt ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) &637 !alt & + sqrt(grav * hur_e(nlci-2,jj)) * (sshn_e(nlci-2,jj) - hbdy_e(jj)) )450 ! Characteristics method: 451 !alt ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) & 452 !alt & + sqrt(grav * hur_e(nlci-2,jj)) * (sshn_e(nlci-2,jj) - hbdy_e(jj)) ) 638 453 END DO 639 454 ENDIF … … 642 457 DO ji=1,jpi 643 458 ua_e(ji,2) = ubdy_s(ji) * hur_e(ji,2) 644 ! Specified fluxes:459 ! Specified fluxes: 645 460 va_e(ji,2) = vbdy_s(ji) * hvr_e(ji,2) 646 ! Characteristics method:647 !alt va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) &648 !alt & - sqrt(grav * hvr_e(ji,2)) * (sshn_e(ji,3) - hbdy_s(ji)) )461 ! Characteristics method: 462 !alt va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) & 463 !alt & - sqrt(grav * hvr_e(ji,2)) * (sshn_e(ji,3) - hbdy_s(ji)) ) 649 464 END DO 650 465 ENDIF … … 653 468 DO ji=1,jpi 654 469 ua_e(ji,nlcj-1) = ubdy_n(ji) * hur_e(ji,nlcj-1) 655 ! Specified fluxes:470 ! Specified fluxes: 656 471 va_e(ji,nlcj-2) = vbdy_n(ji) * hvr_e(ji,nlcj-2) 657 ! Characteristics method:658 !alt va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2) + va_e(ji,nlcj-3) &659 !alt & + sqrt(grav * hvr_e(ji,nlcj-2)) * (sshn_e(ji,nlcj-2) - hbdy_n(ji)) )472 ! Characteristics method: 473 !alt va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2) + va_e(ji,nlcj-3) & 474 !alt & + sqrt(grav * hvr_e(ji,nlcj-2)) * (sshn_e(ji,nlcj-2) - hbdy_n(ji)) ) 660 475 END DO 661 476 ENDIF … … 672 487 INTEGER :: ji, jj 673 488 LOGICAL :: ll_int_cons 674 REAL(wp) :: zrhox, zrhoy, zrhot, zt 675 REAL(wp) :: zaa, zab, zat 676 REAL(wp) :: zt0, zt1 677 REAL(wp), POINTER, DIMENSION(:,:) :: zunb, zvnb, zsshn 678 REAL(wp), POINTER, DIMENSION(:,:) :: zuab, zvab, zubb, zvbb, zutn, zvtn 489 REAL(wp) :: zrhot, zt 679 490 !!---------------------------------------------------------------------- 680 491 … … 682 493 683 494 ll_int_cons = ln_bt_fw ! Assume conservative temporal integration in 684 ! the forward case only 685 686 zrhox = Agrif_Rhox() 687 zrhoy = Agrif_Rhoy() 495 ! the forward case only 496 688 497 zrhot = Agrif_rhot() 689 690 IF ( kt==nit000 ) THEN ! Allocate boundary data arrays691 ALLOCATE( ubdy_w(jpj), vbdy_w(jpj), hbdy_w(jpj))692 ALLOCATE( ubdy_e(jpj), vbdy_e(jpj), hbdy_e(jpj))693 ALLOCATE( ubdy_n(jpi), vbdy_n(jpi), hbdy_n(jpi))694 ALLOCATE( ubdy_s(jpi), vbdy_s(jpi), hbdy_s(jpi))695 ENDIF696 697 CALL wrk_alloc( jpi, jpj, zunb, zvnb, zsshn )698 498 699 499 ! "Central" time index for interpolation: … … 707 507 Agrif_SpecialValue = 0.e0 708 508 Agrif_UseSpecialValue = .TRUE. 709 CALL Agrif_Bc_variable( zsshn,sshn_id,calledweight=zt, procname=interpsshn )509 CALL Agrif_Bc_variable(sshn_id,calledweight=zt, procname=interpsshn ) 710 510 Agrif_UseSpecialValue = .FALSE. 711 511 … … 715 515 716 516 IF (ll_int_cons) THEN ! Conservative interpolation 717 CALL wrk_alloc( jpi, jpj, zuab, zvab, zubb, zvbb, zutn, zvtn ) 718 zuab(:,:) = 0._wp ; zvab(:,:) = 0._wp 719 zubb(:,:) = 0._wp ; zvbb(:,:) = 0._wp 720 zutn(:,:) = 0._wp ; zvtn(:,:) = 0._wp 721 CALL Agrif_Bc_variable(zubb,unb_id ,calledweight=0._wp, procname=interpunb) ! Before 722 CALL Agrif_Bc_variable(zvbb,vnb_id ,calledweight=0._wp, procname=interpvnb) 723 CALL Agrif_Bc_variable(zuab,unb_id ,calledweight=1._wp, procname=interpunb) ! After 724 CALL Agrif_Bc_variable(zvab,vnb_id ,calledweight=1._wp, procname=interpvnb) 725 CALL Agrif_Bc_variable(zutn,ub2b_id,calledweight=1._wp, procname=interpub2b)! Time integrated 726 CALL Agrif_Bc_variable(zvtn,vb2b_id,calledweight=1._wp, procname=interpvb2b) 727 517 ! orders matters here !!!!!! 518 CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1._wp, procname=interpub2b) ! Time integrated 519 CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1._wp, procname=interpvb2b) 520 bdy_tinterp = 1 521 CALL Agrif_Bc_variable(unb_id ,calledweight=1._wp, procname=interpunb) ! After 522 CALL Agrif_Bc_variable(vnb_id ,calledweight=1._wp, procname=interpvnb) 523 bdy_tinterp = 2 524 CALL Agrif_Bc_variable(unb_id ,calledweight=0._wp, procname=interpunb) ! Before 525 CALL Agrif_Bc_variable(vnb_id ,calledweight=0._wp, procname=interpvnb) 526 ELSE ! Linear interpolation 527 bdy_tinterp = 0 528 ubdy_w(:) = 0.e0 ; vbdy_w(:) = 0.e0 529 ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0 530 ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0 531 ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0 532 CALL Agrif_Bc_variable(unb_id,calledweight=zt, procname=interpunb) 533 CALL Agrif_Bc_variable(vnb_id,calledweight=zt, procname=interpvnb) 534 ENDIF 535 Agrif_UseSpecialValue = .FALSE. 536 ! 537 END SUBROUTINE Agrif_dta_ts 538 539 SUBROUTINE Agrif_ssh( kt ) 540 !!---------------------------------------------------------------------- 541 !! *** ROUTINE Agrif_DYN *** 542 !!---------------------------------------------------------------------- 543 INTEGER, INTENT(in) :: kt 544 !! 545 !!---------------------------------------------------------------------- 546 547 IF( Agrif_Root() ) RETURN 548 549 IF((nbondi == -1).OR.(nbondi == 2)) THEN 550 ssha(2,:)=ssha(3,:) 551 sshn(2,:)=sshn(3,:) 552 ENDIF 553 554 IF((nbondi == 1).OR.(nbondi == 2)) THEN 555 ssha(nlci-1,:)=ssha(nlci-2,:) 556 sshn(nlci-1,:)=sshn(nlci-2,:) 557 ENDIF 558 559 IF((nbondj == -1).OR.(nbondj == 2)) THEN 560 ssha(:,2)=ssha(:,3) 561 sshn(:,2)=sshn(:,3) 562 ENDIF 563 564 IF((nbondj == 1).OR.(nbondj == 2)) THEN 565 ssha(:,nlcj-1)=ssha(:,nlcj-2) 566 sshn(:,nlcj-1)=sshn(:,nlcj-2) 567 ENDIF 568 569 END SUBROUTINE Agrif_ssh 570 571 SUBROUTINE Agrif_ssh_ts( jn ) 572 !!---------------------------------------------------------------------- 573 !! *** ROUTINE Agrif_ssh_ts *** 574 !!---------------------------------------------------------------------- 575 INTEGER, INTENT(in) :: jn 576 !! 577 INTEGER :: ji,jj 578 !!---------------------------------------------------------------------- 579 580 IF((nbondi == -1).OR.(nbondi == 2)) THEN 581 DO jj=1,jpj 582 ssha_e(2,jj) = hbdy_w(jj) 583 END DO 584 ENDIF 585 586 IF((nbondi == 1).OR.(nbondi == 2)) THEN 587 DO jj=1,jpj 588 ssha_e(nlci-1,jj) = hbdy_e(jj) 589 END DO 590 ENDIF 591 592 IF((nbondj == -1).OR.(nbondj == 2)) THEN 593 DO ji=1,jpi 594 ssha_e(ji,2) = hbdy_s(ji) 595 END DO 596 ENDIF 597 598 IF((nbondj == 1).OR.(nbondj == 2)) THEN 599 DO ji=1,jpi 600 ssha_e(ji,nlcj-1) = hbdy_n(ji) 601 END DO 602 ENDIF 603 604 END SUBROUTINE Agrif_ssh_ts 605 606 # if defined key_zdftke 607 SUBROUTINE Agrif_tke 608 !!---------------------------------------------------------------------- 609 !! *** ROUTINE Agrif_tke *** 610 !!---------------------------------------------------------------------- 611 REAL(wp) :: zalpha 612 ! 613 zalpha = REAL( Agrif_NbStepint() + Agrif_IRhot() - 1, wp ) / REAL( Agrif_IRhot(), wp ) 614 IF( zalpha > 1. ) zalpha = 1. 615 616 Agrif_SpecialValue = 0.e0 617 Agrif_UseSpecialValue = .TRUE. 618 619 CALL Agrif_Bc_variable(avm_id ,calledweight=zalpha, procname=interpavm) 620 621 Agrif_UseSpecialValue = .FALSE. 622 ! 623 END SUBROUTINE Agrif_tke 624 # endif 625 626 SUBROUTINE interptsn(ptab,i1,i2,j1,j2,k1,k2,n1,n2,before,nb,ndir) 627 !!--------------------------------------------- 628 !! *** ROUTINE interptsn *** 629 !!--------------------------------------------- 630 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab 631 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 632 LOGICAL, INTENT(in) :: before 633 INTEGER, INTENT(in) :: nb , ndir 634 ! 635 INTEGER :: ji, jj, jk, jn ! dummy loop indices 636 INTEGER :: imin, imax, jmin, jmax 637 REAL(wp) :: zrhox , zalpha1, zalpha2, zalpha3 638 REAL(wp) :: zalpha4, zalpha5, zalpha6, zalpha7 639 LOGICAL :: western_side, eastern_side,northern_side,southern_side 640 641 IF (before) THEN 642 ptab(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2) 643 ELSE 644 ! 645 western_side = (nb == 1).AND.(ndir == 1) 646 eastern_side = (nb == 1).AND.(ndir == 2) 647 southern_side = (nb == 2).AND.(ndir == 1) 648 northern_side = (nb == 2).AND.(ndir == 2) 649 ! 650 zrhox = Agrif_Rhox() 651 ! 652 zalpha1 = ( zrhox - 1. ) * 0.5 653 zalpha2 = 1. - zalpha1 654 ! 655 zalpha3 = ( zrhox - 1. ) / ( zrhox + 1. ) 656 zalpha4 = 1. - zalpha3 657 ! 658 zalpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 659 zalpha7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 660 zalpha5 = 1. - zalpha6 - zalpha7 661 ! 662 imin = i1 663 imax = i2 664 jmin = j1 665 jmax = j2 666 ! 667 ! Remove CORNERS 668 IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3 669 IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2 670 IF((nbondi == -1).OR.(nbondi == 2)) imin = 3 671 IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2 672 ! 673 IF( eastern_side) THEN 674 DO jn = 1, jpts 675 tsa(nlci,j1:j2,k1:k2,jn) = zalpha1 * ptab(nlci,j1:j2,k1:k2,jn) + zalpha2 * ptab(nlci-1,j1:j2,k1:k2,jn) 676 DO jk = 1, jpkm1 677 DO jj = jmin,jmax 678 IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 679 tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 680 ELSE 681 tsa(nlci-1,jj,jk,jn)=(zalpha4*tsa(nlci,jj,jk,jn)+zalpha3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 682 IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 683 tsa(nlci-1,jj,jk,jn)=( zalpha6*tsa(nlci-2,jj,jk,jn)+zalpha5*tsa(nlci,jj,jk,jn) & 684 + zalpha7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 685 ENDIF 686 ENDIF 687 END DO 688 END DO 689 ENDDO 690 ENDIF 691 ! 692 IF( northern_side ) THEN 693 DO jn = 1, jpts 694 tsa(i1:i2,nlcj,k1:k2,jn) = zalpha1 * ptab(i1:i2,nlcj,k1:k2,jn) + zalpha2 * ptab(i1:i2,nlcj-1,k1:k2,jn) 695 DO jk = 1, jpkm1 696 DO ji = imin,imax 697 IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN 698 tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 699 ELSE 700 tsa(ji,nlcj-1,jk,jn)=(zalpha4*tsa(ji,nlcj,jk,jn)+zalpha3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk) 701 IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN 702 tsa(ji,nlcj-1,jk,jn)=( zalpha6*tsa(ji,nlcj-2,jk,jn)+zalpha5*tsa(ji,nlcj,jk,jn) & 703 + zalpha7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 704 ENDIF 705 ENDIF 706 END DO 707 END DO 708 ENDDO 709 ENDIF 710 ! 711 IF( western_side) THEN 712 DO jn = 1, jpts 713 tsa(1,j1:j2,k1:k2,jn) = zalpha1 * ptab(1,j1:j2,k1:k2,jn) + zalpha2 * ptab(2,j1:j2,k1:k2,jn) 714 DO jk = 1, jpkm1 715 DO jj = jmin,jmax 716 IF( umask(2,jj,jk) == 0.e0 ) THEN 717 tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk) 718 ELSE 719 tsa(2,jj,jk,jn)=(zalpha4*tsa(1,jj,jk,jn)+zalpha3*tsa(3,jj,jk,jn))*tmask(2,jj,jk) 720 IF( un(2,jj,jk) < 0.e0 ) THEN 721 tsa(2,jj,jk,jn)=(zalpha6*tsa(3,jj,jk,jn)+zalpha5*tsa(1,jj,jk,jn)+zalpha7*tsa(4,jj,jk,jn))*tmask(2,jj,jk) 722 ENDIF 723 ENDIF 724 END DO 725 END DO 726 END DO 727 ENDIF 728 ! 729 IF( southern_side ) THEN 730 DO jn = 1, jpts 731 tsa(i1:i2,1,k1:k2,jn) = zalpha1 * ptab(i1:i2,1,k1:k2,jn) + zalpha2 * ptab(i1:i2,2,k1:k2,jn) 732 DO jk=1,jpk 733 DO ji=imin,imax 734 IF( vmask(ji,2,jk) == 0.e0 ) THEN 735 tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk) 736 ELSE 737 tsa(ji,2,jk,jn)=(zalpha4*tsa(ji,1,jk,jn)+zalpha3*tsa(ji,3,jk,jn))*tmask(ji,2,jk) 738 IF( vn(ji,2,jk) < 0.e0 ) THEN 739 tsa(ji,2,jk,jn)=(zalpha6*tsa(ji,3,jk,jn)+zalpha5*tsa(ji,1,jk,jn)+zalpha7*tsa(ji,4,jk,jn))*tmask(ji,2,jk) 740 ENDIF 741 ENDIF 742 END DO 743 END DO 744 ENDDO 745 ENDIF 746 ! 747 ! Treatment of corners 748 ! 749 ! East south 750 IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN 751 tsa(nlci-1,2,:,:) = ptab(nlci-1,2,:,:) 752 ENDIF 753 ! East north 754 IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN 755 tsa(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:) 756 ENDIF 757 ! West south 758 IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN 759 tsa(2,2,:,:) = ptab(2,2,:,:) 760 ENDIF 761 ! West north 762 IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN 763 tsa(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:) 764 ENDIF 765 ! 766 ENDIF 767 ! 768 END SUBROUTINE interptsn 769 770 SUBROUTINE interpsshn(ptab,i1,i2,j1,j2,before,nb,ndir) 771 !!---------------------------------------------------------------------- 772 !! *** ROUTINE interpsshn *** 773 !!---------------------------------------------------------------------- 774 INTEGER, INTENT(in) :: i1,i2,j1,j2 775 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 776 LOGICAL, INTENT(in) :: before 777 INTEGER, INTENT(in) :: nb , ndir 778 LOGICAL :: western_side, eastern_side,northern_side,southern_side 779 !!---------------------------------------------------------------------- 780 ! 781 IF( before) THEN 782 ptab(i1:i2,j1:j2) = sshn(i1:i2,j1:j2) 783 ELSE 784 western_side = (nb == 1).AND.(ndir == 1) 785 eastern_side = (nb == 1).AND.(ndir == 2) 786 southern_side = (nb == 2).AND.(ndir == 1) 787 northern_side = (nb == 2).AND.(ndir == 2) 788 IF(western_side) hbdy_w(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1) 789 IF(eastern_side) hbdy_e(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1) 790 IF(southern_side) hbdy_s(i1:i2) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1) 791 IF(northern_side) hbdy_n(i1:i2) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1) 792 ENDIF 793 ! 794 END SUBROUTINE interpsshn 795 796 SUBROUTINE interpun(ptab,i1,i2,j1,j2,k1,k2, before) 797 !!--------------------------------------------- 798 !! *** ROUTINE interpun *** 799 !!--------------------------------------------- 800 !! 801 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 802 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 803 LOGICAL, INTENT(in) :: before 804 !! 805 INTEGER :: ji,jj,jk 806 REAL(wp) :: zrhoy 807 !!--------------------------------------------- 808 ! 809 IF (before) THEN 810 DO jk=1,jpk 811 DO jj=j1,j2 812 DO ji=i1,i2 813 ptab(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk) 814 ptab(ji,jj,jk) = ptab(ji,jj,jk) * fse3u(ji,jj,jk) 815 END DO 816 END DO 817 END DO 818 ELSE 819 zrhoy = Agrif_Rhoy() 820 DO jk=1,jpkm1 821 DO jj=j1,j2 822 ua(i1:i2,jj,jk) = (ptab(i1:i2,jj,jk)/(zrhoy*e2u(i1:i2,jj))) 823 ua(i1:i2,jj,jk) = ua(i1:i2,jj,jk) / fse3u(i1:i2,jj,jk) 824 END DO 825 END DO 826 ENDIF 827 ! 828 END SUBROUTINE interpun 829 830 831 SUBROUTINE interpun2d(ptab,i1,i2,j1,j2,before) 832 !!--------------------------------------------- 833 !! *** ROUTINE interpun *** 834 !!--------------------------------------------- 835 ! 836 INTEGER, INTENT(in) :: i1,i2,j1,j2 837 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 838 LOGICAL, INTENT(in) :: before 839 ! 840 INTEGER :: ji,jj 841 REAL(wp) :: ztref 842 REAL(wp) :: zrhoy 843 !!--------------------------------------------- 844 ! 845 ztref = 1. 846 847 IF (before) THEN 848 DO jj=j1,j2 849 DO ji=i1,MIN(i2,nlci-1) 850 ptab(ji,jj) = e2u(ji,jj) * ((gcx(ji+1,jj) - gcx(ji,jj))/e1u(ji,jj)) 851 END DO 852 END DO 853 ELSE 854 zrhoy = Agrif_Rhoy() 855 DO jj=j1,j2 856 laplacu(i1:i2,jj) = ztref * (ptab(i1:i2,jj)/(zrhoy*e2u(i1:i2,jj))) !*umask(i1:i2,jj,1) 857 END DO 858 ENDIF 859 ! 860 END SUBROUTINE interpun2d 861 862 863 SUBROUTINE interpvn(ptab,i1,i2,j1,j2,k1,k2, before) 864 !!--------------------------------------------- 865 !! *** ROUTINE interpvn *** 866 !!--------------------------------------------- 867 ! 868 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 869 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 870 LOGICAL, INTENT(in) :: before 871 ! 872 INTEGER :: ji,jj,jk 873 REAL(wp) :: zrhox 874 !!--------------------------------------------- 875 ! 876 IF (before) THEN 877 !interpv entre 1 et k2 et interpv2d en jpkp1 878 DO jk=k1,jpk 879 DO jj=j1,j2 880 DO ji=i1,i2 881 ptab(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk) 882 ptab(ji,jj,jk) = ptab(ji,jj,jk) * fse3v(ji,jj,jk) 883 END DO 884 END DO 885 END DO 886 ELSE 887 zrhox= Agrif_Rhox() 888 DO jk=1,jpkm1 889 DO jj=j1,j2 890 va(i1:i2,jj,jk) = (ptab(i1:i2,jj,jk)/(zrhox*e1v(i1:i2,jj))) 891 va(i1:i2,jj,jk) = va(i1:i2,jj,jk) / fse3v(i1:i2,jj,jk) 892 END DO 893 END DO 894 ENDIF 895 ! 896 END SUBROUTINE interpvn 897 898 SUBROUTINE interpvn2d(ptab,i1,i2,j1,j2,before) 899 !!--------------------------------------------- 900 !! *** ROUTINE interpvn *** 901 !!--------------------------------------------- 902 ! 903 INTEGER, INTENT(in) :: i1,i2,j1,j2 904 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 905 LOGICAL, INTENT(in) :: before 906 ! 907 INTEGER :: ji,jj 908 REAL(wp) :: zrhox 909 REAL(wp) :: ztref 910 !!--------------------------------------------- 911 ! 912 ztref = 1. 913 IF (before) THEN 914 !interpv entre 1 et k2 et interpv2d en jpkp1 915 DO jj=j1,MIN(j2,nlcj-1) 916 DO ji=i1,i2 917 ptab(ji,jj) = e1v(ji,jj) * ((gcx(ji,jj+1) - gcx(ji,jj))/e2v(ji,jj)) * vmask(ji,jj,1) 918 END DO 919 END DO 920 ELSE 921 zrhox = Agrif_Rhox() 922 DO ji=i1,i2 923 laplacv(ji,j1:j2) = ztref * (ptab(ji,j1:j2)/(zrhox*e1v(ji,j1:j2))) 924 END DO 925 ENDIF 926 ! 927 END SUBROUTINE interpvn2d 928 929 SUBROUTINE interpunb(ptab,i1,i2,j1,j2,before,nb,ndir) 930 !!---------------------------------------------------------------------- 931 !! *** ROUTINE interpunb *** 932 !!---------------------------------------------------------------------- 933 INTEGER, INTENT(in) :: i1,i2,j1,j2 934 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 935 LOGICAL, INTENT(in) :: before 936 INTEGER, INTENT(in) :: nb , ndir 937 !! 938 INTEGER :: ji,jj 939 REAL(wp) :: zrhoy, zrhot, zt0, zt1, ztcoeff 940 LOGICAL :: western_side, eastern_side,northern_side,southern_side 941 !!---------------------------------------------------------------------- 942 ! 943 IF (before) THEN 944 DO jj=j1,j2 945 DO ji=i1,i2 946 ptab(ji,jj) = un_b(ji,jj) * e2u(ji,jj) * hu(ji,jj) 947 END DO 948 END DO 949 ELSE 950 western_side = (nb == 1).AND.(ndir == 1) 951 eastern_side = (nb == 1).AND.(ndir == 2) 952 southern_side = (nb == 2).AND.(ndir == 1) 953 northern_side = (nb == 2).AND.(ndir == 2) 954 zrhoy = Agrif_Rhoy() 955 zrhot = Agrif_rhot() 956 ! Time indexes bounds for integration 957 zt0 = REAL(Agrif_NbStepint() , wp) / zrhot 958 zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot 959 ! Polynomial interpolation coefficients: 960 IF( bdy_tinterp == 1 ) THEN 961 ztcoeff = zrhot * ( zt1**2._wp * ( zt1 - 1._wp) & 962 & - zt0**2._wp * ( zt0 - 1._wp) ) 963 ELSEIF( bdy_tinterp == 2 ) THEN 964 ztcoeff = zrhot * ( zt1 * ( zt1 - 1._wp)**2._wp & 965 & - zt0 * ( zt0 - 1._wp)**2._wp ) 966 967 ELSE 968 ztcoeff = 1 969 ENDIF 970 ! 971 IF(western_side) THEN 972 ubdy_w(j1:j2) = ubdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2) 973 ENDIF 974 IF(eastern_side) THEN 975 ubdy_e(j1:j2) = ubdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2) 976 ENDIF 977 IF(southern_side) THEN 978 ubdy_s(i1:i2) = ubdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j1) 979 ENDIF 980 IF(northern_side) THEN 981 ubdy_n(i1:i2) = ubdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 982 ENDIF 983 ! 984 IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 985 IF(western_side) THEN 986 ubdy_w(j1:j2) = ubdy_w(j1:j2) / (zrhoy*e2u(i1,j1:j2)) & 987 & * umask(i1,j1:j2,1) 988 ENDIF 989 IF(eastern_side) THEN 990 ubdy_e(j1:j2) = ubdy_e(j1:j2) / (zrhoy*e2u(i1,j1:j2)) & 991 & * umask(i1,j1:j2,1) 992 ENDIF 993 IF(southern_side) THEN 994 ubdy_s(i1:i2) = ubdy_s(i1:i2) / (zrhoy*e2u(i1:i2,j1)) & 995 & * umask(i1:i2,j1,1) 996 ENDIF 997 IF(northern_side) THEN 998 ubdy_n(i1:i2) = ubdy_n(i1:i2) / (zrhoy*e2u(i1:i2,j1)) & 999 & * umask(i1:i2,j1,1) 1000 ENDIF 1001 ENDIF 1002 ENDIF 1003 ! 1004 END SUBROUTINE interpunb 1005 1006 SUBROUTINE interpvnb(ptab,i1,i2,j1,j2,before,nb,ndir) 1007 !!---------------------------------------------------------------------- 1008 !! *** ROUTINE interpvnb *** 1009 !!---------------------------------------------------------------------- 1010 INTEGER, INTENT(in) :: i1,i2,j1,j2 1011 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 1012 LOGICAL, INTENT(in) :: before 1013 INTEGER, INTENT(in) :: nb , ndir 1014 !! 1015 INTEGER :: ji,jj 1016 REAL(wp) :: zrhox, zrhot, zt0, zt1, ztcoeff 1017 LOGICAL :: western_side, eastern_side,northern_side,southern_side 1018 !!---------------------------------------------------------------------- 1019 ! 1020 IF (before) THEN 1021 DO jj=j1,j2 1022 DO ji=i1,i2 1023 ptab(ji,jj) = vn_b(ji,jj) * e1v(ji,jj) * hv(ji,jj) 1024 END DO 1025 END DO 1026 ELSE 1027 western_side = (nb == 1).AND.(ndir == 1) 1028 eastern_side = (nb == 1).AND.(ndir == 2) 1029 southern_side = (nb == 2).AND.(ndir == 1) 1030 northern_side = (nb == 2).AND.(ndir == 2) 1031 zrhox = Agrif_Rhox() 1032 zrhot = Agrif_rhot() 1033 ! Time indexes bounds for integration 1034 zt0 = REAL(Agrif_NbStepint() , wp) / zrhot 1035 zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot 1036 IF( bdy_tinterp == 1 ) THEN 1037 ztcoeff = zrhot * ( zt1**2._wp * ( zt1 - 1._wp) & 1038 & - zt0**2._wp * ( zt0 - 1._wp) ) 1039 ELSEIF( bdy_tinterp == 2 ) THEN 1040 ztcoeff = zrhot * ( zt1 * ( zt1 - 1._wp)**2._wp & 1041 & - zt0 * ( zt0 - 1._wp)**2._wp ) 1042 1043 ELSE 1044 ztcoeff = 1 1045 ENDIF 1046 ! 1047 IF(western_side) THEN 1048 vbdy_w(j1:j2) = vbdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2) 1049 ENDIF 1050 IF(eastern_side) THEN 1051 vbdy_e(j1:j2) = vbdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2) 1052 ENDIF 1053 IF(southern_side) THEN 1054 vbdy_s(i1:i2) = vbdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j1) 1055 ENDIF 1056 IF(northern_side) THEN 1057 vbdy_n(i1:i2) = vbdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 1058 ENDIF 1059 ! 1060 IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 1061 IF(western_side) THEN 1062 vbdy_w(j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i1,j1:j2)) & 1063 & * vmask(i1,j1:j2,1) 1064 ENDIF 1065 IF(eastern_side) THEN 1066 vbdy_e(j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i1,j1:j2)) & 1067 & * vmask(i1,j1:j2,1) 1068 ENDIF 1069 IF(southern_side) THEN 1070 vbdy_s(i1:i2) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j1)) & 1071 & * vmask(i1:i2,j1,1) 1072 ENDIF 1073 IF(northern_side) THEN 1074 vbdy_n(i1:i2) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1)) & 1075 & * vmask(i1:i2,j1,1) 1076 ENDIF 1077 ENDIF 1078 ENDIF 1079 ! 1080 END SUBROUTINE interpvnb 1081 1082 SUBROUTINE interpub2b(ptab,i1,i2,j1,j2,before,nb,ndir) 1083 !!---------------------------------------------------------------------- 1084 !! *** ROUTINE interpub2b *** 1085 !!---------------------------------------------------------------------- 1086 INTEGER, INTENT(in) :: i1,i2,j1,j2 1087 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 1088 LOGICAL, INTENT(in) :: before 1089 INTEGER, INTENT(in) :: nb , ndir 1090 !! 1091 INTEGER :: ji,jj 1092 REAL(wp) :: zrhot, zt0, zt1,zat 1093 LOGICAL :: western_side, eastern_side,northern_side,southern_side 1094 !!---------------------------------------------------------------------- 1095 IF( before ) THEN 1096 DO jj=j1,j2 1097 DO ji=i1,i2 1098 ptab(ji,jj) = ub2_b(ji,jj) * e2u(ji,jj) 1099 END DO 1100 END DO 1101 ELSE 1102 western_side = (nb == 1).AND.(ndir == 1) 1103 eastern_side = (nb == 1).AND.(ndir == 2) 1104 southern_side = (nb == 2).AND.(ndir == 1) 1105 northern_side = (nb == 2).AND.(ndir == 2) 1106 zrhot = Agrif_rhot() 728 1107 ! Time indexes bounds for integration 729 1108 zt0 = REAL(Agrif_NbStepint() , wp) / zrhot 730 1109 zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot 731 732 1110 ! Polynomial interpolation coefficients: 733 zaa = zrhot * ( zt1**2._wp * ( zt1 - 1._wp) &734 & - zt0**2._wp * ( zt0 - 1._wp) )735 zab = zrhot * ( zt1 * ( zt1 - 1._wp)**2._wp &736 & - zt0 * ( zt0 - 1._wp)**2._wp )737 1111 zat = zrhot * ( zt1**2._wp * (-2._wp*zt1 + 3._wp) & 738 & - zt0**2._wp * (-2._wp*zt0 + 3._wp) ) 739 740 ! Do time interpolation 741 IF((nbondi == -1).OR.(nbondi == 2)) THEN 742 DO jj=1,jpj 743 zunb(2,jj) = zaa * zuab(2,jj) + zab * zubb(2,jj) + zat * zutn(2,jj) 744 zvnb(2,jj) = zaa * zvab(2,jj) + zab * zvbb(2,jj) + zat * zvtn(2,jj) 745 END DO 746 ENDIF 747 IF((nbondi == 1).OR.(nbondi == 2)) THEN 748 DO jj=1,jpj 749 zunb(nlci-2,jj) = zaa * zuab(nlci-2,jj) + zab * zubb(nlci-2,jj) + zat * zutn(nlci-2,jj) 750 zvnb(nlci-1,jj) = zaa * zvab(nlci-1,jj) + zab * zvbb(nlci-1,jj) + zat * zvtn(nlci-1,jj) 751 END DO 752 ENDIF 753 IF((nbondj == -1).OR.(nbondj == 2)) THEN 754 DO ji=1,jpi 755 zunb(ji,2) = zaa * zuab(ji,2) + zab * zubb(ji,2) + zat * zutn(ji,2) 756 zvnb(ji,2) = zaa * zvab(ji,2) + zab * zvbb(ji,2) + zat * zvtn(ji,2) 757 END DO 758 ENDIF 759 IF((nbondj == 1).OR.(nbondj == 2)) THEN 760 DO ji=1,jpi 761 zunb(ji,nlcj-1) = zaa * zuab(ji,nlcj-1) + zab * zubb(ji,nlcj-1) + zat * zutn(ji,nlcj-1) 762 zvnb(ji,nlcj-2) = zaa * zvab(ji,nlcj-2) + zab * zvbb(ji,nlcj-2) + zat * zvtn(ji,nlcj-2) 763 END DO 764 ENDIF 765 CALL wrk_dealloc( jpi, jpj, zuab, zvab, zubb, zvbb, zutn, zvtn ) 766 767 ELSE ! Linear interpolation 768 zunb(:,:) = 0._wp ; zvnb(:,:) = 0._wp 769 CALL Agrif_Bc_variable(zunb,unb_id,calledweight=zt, procname=interpunb) 770 CALL Agrif_Bc_variable(zvnb,vnb_id,calledweight=zt, procname=interpvnb) 771 ENDIF 772 Agrif_UseSpecialValue = .FALSE. 773 774 ! Fill boundary data arrays: 775 IF((nbondi == -1).OR.(nbondi == 2)) THEN 776 DO jj=1,jpj 777 ubdy_w(jj) = (zunb(2,jj)/(zrhoy*e2u(2,jj))) * umask(2,jj,1) 778 vbdy_w(jj) = (zvnb(2,jj)/(zrhox*e1v(2,jj))) * vmask(2,jj,1) 779 hbdy_w(jj) = zsshn(2,jj) * tmask(2,jj,1) 780 END DO 781 ENDIF 782 783 IF((nbondi == 1).OR.(nbondi == 2)) THEN 784 DO jj=1,jpj 785 ubdy_e(jj) = zunb(nlci-2,jj)/(zrhoy*e2u(nlci-2,jj)) * umask(nlci-2,jj,1) 786 vbdy_e(jj) = zvnb(nlci-1,jj)/(zrhox*e1v(nlci-1,jj)) * vmask(nlci-1,jj,1) 787 hbdy_e(jj) = zsshn(nlci-1,jj) * tmask(nlci-1,jj,1) 788 END DO 789 ENDIF 790 791 IF((nbondj == -1).OR.(nbondj == 2)) THEN 792 DO ji=1,jpi 793 ubdy_s(ji) = zunb(ji,2)/(zrhoy*e2u(ji,2)) * umask(ji,2,1) 794 vbdy_s(ji) = zvnb(ji,2)/(zrhox*e1v(ji,2)) * vmask(ji,2,1) 795 hbdy_s(ji) = zsshn(ji,2) * tmask(ji,2,1) 796 END DO 797 ENDIF 798 799 IF((nbondj == 1).OR.(nbondj == 2)) THEN 800 DO ji=1,jpi 801 ubdy_n(ji) = zunb(ji,nlcj-1)/(zrhoy*e2u(ji,nlcj-1)) * umask(ji,nlcj-1,1) 802 vbdy_n(ji) = zvnb(ji,nlcj-2)/(zrhox*e1v(ji,nlcj-2)) * vmask(ji,nlcj-2,1) 803 hbdy_n(ji) = zsshn(ji,nlcj-1) * tmask(ji,nlcj-1,1) 804 END DO 805 ENDIF 806 807 CALL wrk_dealloc( jpi, jpj, zunb, zvnb, zsshn ) 808 809 END SUBROUTINE Agrif_dta_ts 810 811 SUBROUTINE Agrif_ssh( kt ) 812 !!---------------------------------------------------------------------- 813 !! *** ROUTINE Agrif_DYN *** 814 !!---------------------------------------------------------------------- 815 INTEGER, INTENT(in) :: kt 816 !! 817 !!---------------------------------------------------------------------- 818 819 IF( Agrif_Root() ) RETURN 820 821 822 IF((nbondi == -1).OR.(nbondi == 2)) THEN 823 ssha(2,:)=ssha(3,:) 824 sshn(2,:)=sshn(3,:) 825 ENDIF 826 827 IF((nbondi == 1).OR.(nbondi == 2)) THEN 828 ssha(nlci-1,:)=ssha(nlci-2,:) 829 sshn(nlci-1,:)=sshn(nlci-2,:) 830 ENDIF 831 832 IF((nbondj == -1).OR.(nbondj == 2)) THEN 833 ssha(:,2)=ssha(:,3) 834 sshn(:,2)=sshn(:,3) 835 ENDIF 836 837 IF((nbondj == 1).OR.(nbondj == 2)) THEN 838 ssha(:,nlcj-1)=ssha(:,nlcj-2) 839 sshn(:,nlcj-1)=sshn(:,nlcj-2) 840 ENDIF 841 842 END SUBROUTINE Agrif_ssh 843 844 SUBROUTINE Agrif_ssh_ts( jn ) 845 !!---------------------------------------------------------------------- 846 !! *** ROUTINE Agrif_ssh_ts *** 847 !!---------------------------------------------------------------------- 848 INTEGER, INTENT(in) :: jn 1112 & - zt0**2._wp * (-2._wp*zt0 + 3._wp) ) 1113 ! 1114 IF(western_side ) ubdy_w(j1:j2) = zat * ptab(i1,j1:j2) 1115 IF(eastern_side ) ubdy_e(j1:j2) = zat * ptab(i1,j1:j2) 1116 IF(southern_side) ubdy_s(i1:i2) = zat * ptab(i1:i2,j1) 1117 IF(northern_side) ubdy_n(i1:i2) = zat * ptab(i1:i2,j1) 1118 ENDIF 1119 ! 1120 END SUBROUTINE interpub2b 1121 1122 SUBROUTINE interpvb2b(ptab,i1,i2,j1,j2,before,nb,ndir) 1123 !!---------------------------------------------------------------------- 1124 !! *** ROUTINE interpvb2b *** 1125 !!---------------------------------------------------------------------- 1126 INTEGER, INTENT(in) :: i1,i2,j1,j2 1127 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 1128 LOGICAL, INTENT(in) :: before 1129 INTEGER, INTENT(in) :: nb , ndir 849 1130 !! 850 1131 INTEGER :: ji,jj 851 !!---------------------------------------------------------------------- 852 853 IF((nbondi == -1).OR.(nbondi == 2)) THEN 854 DO jj=1,jpj 855 ssha_e(2,jj) = hbdy_w(jj) 856 END DO 857 ENDIF 858 859 IF((nbondi == 1).OR.(nbondi == 2)) THEN 860 DO jj=1,jpj 861 ssha_e(nlci-1,jj) = hbdy_e(jj) 862 END DO 863 ENDIF 864 865 IF((nbondj == -1).OR.(nbondj == 2)) THEN 866 DO ji=1,jpi 867 ssha_e(ji,2) = hbdy_s(ji) 868 END DO 869 ENDIF 870 871 IF((nbondj == 1).OR.(nbondj == 2)) THEN 872 DO ji=1,jpi 873 ssha_e(ji,nlcj-1) = hbdy_n(ji) 874 END DO 875 ENDIF 876 877 END SUBROUTINE Agrif_ssh_ts 878 879 SUBROUTINE interpsshn(tabres,i1,i2,j1,j2) 880 !!---------------------------------------------------------------------- 881 !! *** ROUTINE interpsshn *** 882 !!---------------------------------------------------------------------- 883 INTEGER, INTENT(in) :: i1,i2,j1,j2 884 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 885 !! 886 INTEGER :: ji,jj 887 !!---------------------------------------------------------------------- 888 889 tabres(i1:i2,j1:j2) = sshn(i1:i2,j1:j2) 890 891 END SUBROUTINE interpsshn 892 893 SUBROUTINE interpu(tabres,i1,i2,j1,j2,k1,k2) 894 !!---------------------------------------------------------------------- 895 !! *** ROUTINE interpu *** 896 !!---------------------------------------------------------------------- 897 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 898 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 899 !! 900 INTEGER :: ji,jj,jk 901 !!---------------------------------------------------------------------- 902 903 DO jk=k1,k2 1132 REAL(wp) :: zrhot, zt0, zt1,zat 1133 LOGICAL :: western_side, eastern_side,northern_side,southern_side 1134 !!---------------------------------------------------------------------- 1135 ! 1136 IF( before ) THEN 904 1137 DO jj=j1,j2 905 1138 DO ji=i1,i2 906 tabres(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk) 907 tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3u_n(ji,jj,jk) 908 END DO 909 END DO 910 END DO 911 END SUBROUTINE interpu 912 913 914 SUBROUTINE interpu2d(tabres,i1,i2,j1,j2) 915 !!---------------------------------------------------------------------- 916 !! *** ROUTINE interpu2d *** 917 !!---------------------------------------------------------------------- 918 INTEGER, INTENT(in) :: i1,i2,j1,j2 919 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 920 !! 921 INTEGER :: ji,jj 922 !!---------------------------------------------------------------------- 923 924 DO jj=j1,j2 925 DO ji=i1,i2 926 tabres(ji,jj) = e2u(ji,jj) * ((gcx(ji+1,jj) - gcx(ji,jj))/e1u(ji,jj)) & 927 * umask(ji,jj,1) 928 END DO 929 END DO 930 931 END SUBROUTINE interpu2d 932 933 934 SUBROUTINE interpv(tabres,i1,i2,j1,j2,k1,k2) 935 !!---------------------------------------------------------------------- 936 !! *** ROUTINE interpv *** 937 !!---------------------------------------------------------------------- 1139 ptab(ji,jj) = vb2_b(ji,jj) * e1v(ji,jj) 1140 END DO 1141 END DO 1142 ELSE 1143 western_side = (nb == 1).AND.(ndir == 1) 1144 eastern_side = (nb == 1).AND.(ndir == 2) 1145 southern_side = (nb == 2).AND.(ndir == 1) 1146 northern_side = (nb == 2).AND.(ndir == 2) 1147 zrhot = Agrif_rhot() 1148 ! Time indexes bounds for integration 1149 zt0 = REAL(Agrif_NbStepint() , wp) / zrhot 1150 zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot 1151 ! Polynomial interpolation coefficients: 1152 zat = zrhot * ( zt1**2._wp * (-2._wp*zt1 + 3._wp) & 1153 & - zt0**2._wp * (-2._wp*zt0 + 3._wp) ) 1154 ! 1155 IF(western_side ) vbdy_w(j1:j2) = zat * ptab(i1,j1:j2) 1156 IF(eastern_side ) vbdy_e(j1:j2) = zat * ptab(i1,j1:j2) 1157 IF(southern_side) vbdy_s(i1:i2) = zat * ptab(i1:i2,j1) 1158 IF(northern_side) vbdy_n(i1:i2) = zat * ptab(i1:i2,j1) 1159 ENDIF 1160 ! 1161 END SUBROUTINE interpvb2b 1162 1163 SUBROUTINE interpe3t(ptab,i1,i2,j1,j2,k1,k2,before,nb,ndir) 1164 !!---------------------------------------------------------------------- 1165 !! *** ROUTINE interpe3t *** 1166 !!---------------------------------------------------------------------- 1167 ! 938 1168 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 939 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 940 !! 1169 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 1170 LOGICAL :: before 1171 INTEGER, INTENT(in) :: nb , ndir 1172 ! 941 1173 INTEGER :: ji, jj, jk 942 !!---------------------------------------------------------------------- 943 944 DO jk=k1,k2 945 DO jj=j1,j2 946 DO ji=i1,i2 947 tabres(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk) 948 tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3v_n(ji,jj,jk) 949 END DO 950 END DO 951 END DO 952 953 END SUBROUTINE interpv 954 955 956 SUBROUTINE interpv2d(tabres,i1,i2,j1,j2) 957 !!---------------------------------------------------------------------- 958 !! *** ROUTINE interpu2d *** 959 !!---------------------------------------------------------------------- 960 INTEGER, INTENT(in) :: i1,i2,j1,j2 961 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 962 !! 963 INTEGER :: ji,jj 964 !!---------------------------------------------------------------------- 965 966 DO jj=j1,j2 967 DO ji=i1,i2 968 tabres(ji,jj) = e1v(ji,jj) * ((gcx(ji,jj+1) - gcx(ji,jj))/e2v(ji,jj)) & 969 * vmask(ji,jj,1) 970 END DO 971 END DO 972 973 END SUBROUTINE interpv2d 974 975 SUBROUTINE interpunb(tabres,i1,i2,j1,j2) 976 !!---------------------------------------------------------------------- 977 !! *** ROUTINE interpunb *** 978 !!---------------------------------------------------------------------- 979 INTEGER, INTENT(in) :: i1,i2,j1,j2 980 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 981 !! 982 INTEGER :: ji,jj 983 !!---------------------------------------------------------------------- 984 985 DO jj=j1,j2 986 DO ji=i1,i2 987 tabres(ji,jj) = un_b(ji,jj) * e2u(ji,jj) * hu(ji,jj) 988 END DO 989 END DO 990 991 END SUBROUTINE interpunb 992 993 SUBROUTINE interpvnb(tabres,i1,i2,j1,j2) 994 !!---------------------------------------------------------------------- 995 !! *** ROUTINE interpvnb *** 996 !!---------------------------------------------------------------------- 997 INTEGER, INTENT(in) :: i1,i2,j1,j2 998 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 999 !! 1000 INTEGER :: ji,jj 1001 !!---------------------------------------------------------------------- 1002 1003 DO jj=j1,j2 1004 DO ji=i1,i2 1005 tabres(ji,jj) = vn_b(ji,jj) * e1v(ji,jj) * hv(ji,jj) 1006 END DO 1007 END DO 1008 1009 END SUBROUTINE interpvnb 1010 1011 SUBROUTINE interpub2b(tabres,i1,i2,j1,j2) 1012 !!---------------------------------------------------------------------- 1013 !! *** ROUTINE interpub2b *** 1014 !!---------------------------------------------------------------------- 1015 INTEGER, INTENT(in) :: i1,i2,j1,j2 1016 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 1017 !! 1018 INTEGER :: ji,jj 1019 !!---------------------------------------------------------------------- 1020 1021 DO jj=j1,j2 1022 DO ji=i1,i2 1023 tabres(ji,jj) = ub2_b(ji,jj) * e2u(ji,jj) 1024 END DO 1025 END DO 1026 1027 END SUBROUTINE interpub2b 1028 1029 SUBROUTINE interpvb2b(tabres,i1,i2,j1,j2) 1030 !!---------------------------------------------------------------------- 1031 !! *** ROUTINE interpvb2b *** 1032 !!---------------------------------------------------------------------- 1033 INTEGER, INTENT(in) :: i1,i2,j1,j2 1034 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 1035 !! 1036 INTEGER :: ji,jj 1037 !!---------------------------------------------------------------------- 1038 1039 DO jj=j1,j2 1040 DO ji=i1,i2 1041 tabres(ji,jj) = vb2_b(ji,jj) * e1v(ji,jj) 1042 END DO 1043 END DO 1044 1045 END SUBROUTINE interpvb2b 1174 LOGICAL :: western_side, eastern_side, northern_side, southern_side 1175 REAL(wp) :: ztmpmsk 1176 !!---------------------------------------------------------------------- 1177 ! 1178 IF (before) THEN 1179 DO jk=k1,k2 1180 DO jj=j1,j2 1181 DO ji=i1,i2 1182 ptab(ji,jj,jk) = tmask(ji,jj,jk) * e3t_0(ji,jj,jk) 1183 END DO 1184 END DO 1185 END DO 1186 ELSE 1187 western_side = (nb == 1).AND.(ndir == 1) 1188 eastern_side = (nb == 1).AND.(ndir == 2) 1189 southern_side = (nb == 2).AND.(ndir == 1) 1190 northern_side = (nb == 2).AND.(ndir == 2) 1191 1192 DO jk=k1,k2 1193 DO jj=j1,j2 1194 DO ji=i1,i2 1195 ! Get velocity mask at boundary edge points: 1196 IF (western_side) ztmpmsk = umask(ji ,jj ,1) 1197 IF (eastern_side) ztmpmsk = umask(nlci-2,jj ,1) 1198 IF (northern_side) ztmpmsk = vmask(ji ,nlcj-2,1) 1199 IF (southern_side) ztmpmsk = vmask(ji ,2 ,1) 1200 1201 IF (ABS(ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk))*ztmpmsk > 1.D-2) THEN 1202 IF (western_side) THEN 1203 WRITE(numout,*) 'ERROR bathymetry merge at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 1204 ELSEIF (eastern_side) THEN 1205 WRITE(numout,*) 'ERROR bathymetry merge at the eastern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 1206 ELSEIF (southern_side) THEN 1207 WRITE(numout,*) 'ERROR bathymetry merge at the southern border ji,jj,jk', ji+nimpp-1,jj+njmpp-1,jk 1208 ELSEIF (northern_side) THEN 1209 WRITE(numout,*) 'ERROR bathymetry merge at the northen border ji,jj,jk', ji+nimpp-1,jj+njmpp-1,jk 1210 ENDIF 1211 WRITE(numout,*) ' ptab(ji,jj,jk), fse3t(ji,jj,jk) ', ptab(ji,jj,jk), e3t_0(ji,jj,jk) 1212 kindic_agr = kindic_agr + 1 1213 ENDIF 1214 END DO 1215 END DO 1216 END DO 1217 1218 ENDIF 1219 ! 1220 END SUBROUTINE interpe3t 1221 1222 SUBROUTINE interpumsk(ptab,i1,i2,j1,j2,k1,k2,before,nb,ndir) 1223 !!---------------------------------------------------------------------- 1224 !! *** ROUTINE interpumsk *** 1225 !!---------------------------------------------------------------------- 1226 ! 1227 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 1228 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 1229 LOGICAL :: before 1230 INTEGER, INTENT(in) :: nb , ndir 1231 ! 1232 INTEGER :: ji, jj, jk 1233 LOGICAL :: western_side, eastern_side 1234 !!---------------------------------------------------------------------- 1235 ! 1236 IF (before) THEN 1237 DO jk=k1,k2 1238 DO jj=j1,j2 1239 DO ji=i1,i2 1240 ptab(ji,jj,jk) = umask(ji,jj,jk) 1241 END DO 1242 END DO 1243 END DO 1244 ELSE 1245 1246 western_side = (nb == 1).AND.(ndir == 1) 1247 eastern_side = (nb == 1).AND.(ndir == 2) 1248 DO jk=k1,k2 1249 DO jj=j1,j2 1250 DO ji=i1,i2 1251 ! Velocity mask at boundary edge points: 1252 IF (ABS(ptab(ji,jj,jk) - umask(ji,jj,jk)) > 1.D-2) THEN 1253 IF (western_side) THEN 1254 WRITE(numout,*) 'ERROR with umask at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 1255 WRITE(numout,*) ' masks: parent, child ', ptab(ji,jj,jk), umask(ji,jj,jk) 1256 kindic_agr = kindic_agr + 1 1257 ELSEIF (eastern_side) THEN 1258 WRITE(numout,*) 'ERROR with umask at the eastern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 1259 WRITE(numout,*) ' masks: parent, child ', ptab(ji,jj,jk), umask(ji,jj,jk) 1260 kindic_agr = kindic_agr + 1 1261 ENDIF 1262 ENDIF 1263 END DO 1264 END DO 1265 END DO 1266 1267 ENDIF 1268 ! 1269 END SUBROUTINE interpumsk 1270 1271 SUBROUTINE interpvmsk(ptab,i1,i2,j1,j2,k1,k2,before,nb,ndir) 1272 !!---------------------------------------------------------------------- 1273 !! *** ROUTINE interpvmsk *** 1274 !!---------------------------------------------------------------------- 1275 ! 1276 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 1277 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 1278 LOGICAL :: before 1279 INTEGER, INTENT(in) :: nb , ndir 1280 ! 1281 INTEGER :: ji, jj, jk 1282 LOGICAL :: northern_side, southern_side 1283 !!---------------------------------------------------------------------- 1284 ! 1285 IF (before) THEN 1286 DO jk=k1,k2 1287 DO jj=j1,j2 1288 DO ji=i1,i2 1289 ptab(ji,jj,jk) = vmask(ji,jj,jk) 1290 END DO 1291 END DO 1292 END DO 1293 ELSE 1294 1295 southern_side = (nb == 2).AND.(ndir == 1) 1296 northern_side = (nb == 2).AND.(ndir == 2) 1297 DO jk=k1,k2 1298 DO jj=j1,j2 1299 DO ji=i1,i2 1300 ! Velocity mask at boundary edge points: 1301 IF (ABS(ptab(ji,jj,jk) - vmask(ji,jj,jk)) > 1.D-2) THEN 1302 IF (southern_side) THEN 1303 WRITE(numout,*) 'ERROR with vmask at the southern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 1304 WRITE(numout,*) ' masks: parent, child ', ptab(ji,jj,jk), vmask(ji,jj,jk) 1305 kindic_agr = kindic_agr + 1 1306 ELSEIF (northern_side) THEN 1307 WRITE(numout,*) 'ERROR with vmask at the northern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 1308 WRITE(numout,*) ' masks: parent, child ', ptab(ji,jj,jk), vmask(ji,jj,jk) 1309 kindic_agr = kindic_agr + 1 1310 ENDIF 1311 ENDIF 1312 END DO 1313 END DO 1314 END DO 1315 1316 ENDIF 1317 ! 1318 END SUBROUTINE interpvmsk 1319 1320 # if defined key_zdftke 1321 1322 SUBROUTINE interpavm(ptab,i1,i2,j1,j2,k1,k2,before) 1323 !!---------------------------------------------------------------------- 1324 !! *** ROUTINE interavm *** 1325 !!---------------------------------------------------------------------- 1326 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 1327 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 1328 LOGICAL, INTENT(in) :: before 1329 !!---------------------------------------------------------------------- 1330 ! 1331 IF( before) THEN 1332 ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2) 1333 ELSE 1334 avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 1335 ENDIF 1336 ! 1337 END SUBROUTINE interpavm 1338 1339 # endif /* key_zdftke */ 1046 1340 1047 1341 #else -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90
r4153 r6204 1 1 #define SPONGE && define SPONGE_TOP 2 2 3 M oduleagrif_opa_sponge3 MODULE agrif_opa_sponge 4 4 #if defined key_agrif && ! defined key_offline 5 5 USE par_oce … … 9 9 USE agrif_oce 10 10 USE wrk_nemo 11 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 11 12 12 13 IMPLICIT NONE 13 14 PRIVATE 14 15 15 PUBLIC Agrif_Sponge, Agrif_Sponge_Tra, Agrif_Sponge_Dyn, interptsn, interpun, interpvn 16 17 !! * Substitutions 16 PUBLIC Agrif_Sponge, Agrif_Sponge_Tra, Agrif_Sponge_Dyn 17 PUBLIC interptsn_sponge, interpun_sponge, interpvn_sponge 18 19 !! * Substitutions 18 20 # include "domzgr_substitute.h90" 19 21 !!---------------------------------------------------------------------- … … 23 25 !!---------------------------------------------------------------------- 24 26 25 27 CONTAINS 26 28 27 29 SUBROUTINE Agrif_Sponge_Tra … … 30 32 !!--------------------------------------------- 31 33 !! 32 INTEGER :: ji,jj,jk,jn33 34 REAL(wp) :: timecoeff 34 REAL(wp) :: ztsa, zabe1, zabe2, zbtr35 REAL(wp), POINTER, DIMENSION(:,: ) :: ztu, ztv36 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab37 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: tsbdiff38 35 39 36 #if defined SPONGE 40 CALL wrk_alloc( jpi, jpj, ztu, ztv )41 CALL wrk_alloc( jpi, jpj, jpk, jpts, ztab, tsbdiff )42 43 37 timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 44 38 39 CALL Agrif_Sponge 45 40 Agrif_SpecialValue=0. 46 41 Agrif_UseSpecialValue = .TRUE. 47 ztab = 0.e0 48 CALL Agrif_Bc_Variable(ztab, tsa_id,calledweight=timecoeff,procname=interptsn) 42 tabspongedone_tsn = .FALSE. 43 44 CALL Agrif_Bc_Variable(tsn_sponge_id,calledweight=timecoeff,procname=interptsn_sponge) 45 49 46 Agrif_UseSpecialValue = .FALSE. 50 51 tsbdiff(:,:,:,:) = tsb(:,:,:,:) - ztab(:,:,:,:)52 53 CALL Agrif_Sponge54 55 DO jn = 1, jpts56 DO jk = 1, jpkm157 !58 DO jj = 1, jpjm159 DO ji = 1, jpim160 zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk)61 zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk)62 ztu(ji,jj) = zabe1 * ( tsbdiff(ji+1,jj ,jk,jn) - tsbdiff(ji,jj,jk,jn) )63 ztv(ji,jj) = zabe2 * ( tsbdiff(ji ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) )64 ENDDO65 ENDDO66 67 DO jj = 2, jpjm168 DO ji = 2, jpim169 zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk)70 ! horizontal diffusive trends71 ztsa = zbtr * ( ztu(ji,jj) - ztu(ji-1,jj ) &72 & + ztv(ji,jj) - ztv(ji ,jj-1) )73 ! add it to the general tracer trends74 tsa(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) + ztsa75 END DO76 END DO77 !78 ENDDO79 ENDDO80 81 CALL wrk_dealloc( jpi, jpj, ztu, ztv )82 CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztab, tsbdiff )83 47 #endif 84 48 … … 90 54 !!--------------------------------------------- 91 55 !! 92 INTEGER :: ji,jj,jk93 56 REAL(wp) :: timecoeff 94 REAL(wp) :: ze2u, ze1v, zua, zva, zbtr95 REAL(wp), POINTER, DIMENSION(:,:,:) :: ubdiff, vbdiff96 REAL(wp), POINTER, DIMENSION(:,:,:) :: rotdiff, hdivdiff97 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztab98 57 99 58 #if defined SPONGE 100 CALL wrk_alloc( jpi, jpj, jpk, ztab, ubdiff, vbdiff, rotdiff, hdivdiff )101 102 59 timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 103 60 104 61 Agrif_SpecialValue=0. 105 62 Agrif_UseSpecialValue = ln_spc_dyn 106 ztab = 0.e0 107 CALL Agrif_Bc_Variable(ztab, ua_id,calledweight=timecoeff,procname=interpun) 63 64 tabspongedone_u = .FALSE. 65 tabspongedone_v = .FALSE. 66 CALL Agrif_Bc_Variable(un_sponge_id,calledweight=timecoeff,procname=interpun_sponge) 67 68 tabspongedone_u = .FALSE. 69 tabspongedone_v = .FALSE. 70 CALL Agrif_Bc_Variable(vn_sponge_id,calledweight=timecoeff,procname=interpvn_sponge) 71 108 72 Agrif_UseSpecialValue = .FALSE. 109 110 ubdiff(:,:,:) = ( ub(:,:,:) - ztab(:,:,:) ) * umask(:,:,:)111 112 ztab = 0.e0113 Agrif_SpecialValue=0.114 Agrif_UseSpecialValue = ln_spc_dyn115 CALL Agrif_Bc_Variable(ztab, va_id,calledweight=timecoeff,procname=interpvn)116 Agrif_UseSpecialValue = .FALSE.117 118 vbdiff(:,:,:) = ( vb(:,:,:) - ztab(:,:,:) ) * vmask(:,:,:)119 120 CALL Agrif_Sponge121 122 DO jk = 1,jpkm1123 ubdiff(:,:,jk) = ubdiff(:,:,jk) * spe1ur2(:,:)124 vbdiff(:,:,jk) = vbdiff(:,:,jk) * spe2vr2(:,:)125 ENDDO126 127 hdivdiff = 0.128 rotdiff = 0.129 130 DO jk = 1, jpkm1 ! Horizontal slab131 ! ! ===============132 133 ! ! --------134 ! Horizontal divergence ! div135 ! ! --------136 DO jj = 2, jpjm1137 DO ji = 2, jpim1 ! vector opt.138 zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk)139 hdivdiff(ji,jj,jk) = ( e2u(ji ,jj ) * fse3u(ji ,jj ,jk) * ubdiff(ji ,jj ,jk) &140 & - e2u(ji-1,jj ) * fse3u(ji-1,jj ,jk) * ubdiff(ji-1,jj ,jk) &141 & + e1v(ji ,jj ) * fse3v(ji ,jj ,jk) * vbdiff(ji ,jj ,jk) &142 & - e1v(ji ,jj-1) * fse3v(ji ,jj-1,jk) * vbdiff(ji ,jj-1,jk) ) * zbtr143 END DO144 END DO145 146 DO jj = 1, jpjm1147 DO ji = 1, jpim1 ! vector opt.148 zbtr = spbtr3(ji,jj) * fse3f(ji,jj,jk)149 rotdiff(ji,jj,jk) = ( e2v(ji+1,jj ) * vbdiff(ji+1,jj ,jk) - e2v(ji,jj) * vbdiff(ji,jj,jk) &150 & - e1u(ji ,jj+1) * ubdiff(ji ,jj+1,jk) + e1u(ji,jj) * ubdiff(ji,jj,jk) ) &151 & * fmask(ji,jj,jk) * zbtr152 END DO153 END DO154 155 ENDDO156 157 ! ! ===============158 DO jk = 1, jpkm1 ! Horizontal slab159 ! ! ===============160 DO jj = 2, jpjm1161 DO ji = 2, jpim1 ! vector opt.162 ! horizontal diffusive trends163 zua = - ( rotdiff (ji ,jj,jk) - rotdiff (ji,jj-1,jk) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) ) &164 + ( hdivdiff(ji+1,jj,jk) - hdivdiff(ji,jj ,jk) ) / e1u(ji,jj)165 166 zva = + ( rotdiff (ji,jj ,jk) - rotdiff (ji-1,jj,jk) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) ) &167 + ( hdivdiff(ji,jj+1,jk) - hdivdiff(ji ,jj,jk) ) / e2v(ji,jj)168 ! add it to the general momentum trends169 ua(ji,jj,jk) = ua(ji,jj,jk) + zua170 va(ji,jj,jk) = va(ji,jj,jk) + zva171 END DO172 END DO173 ! ! ===============174 END DO ! End of slab175 ! ! ===============176 CALL wrk_dealloc( jpi, jpj, jpk, ztab, ubdiff, vbdiff, rotdiff, hdivdiff )177 73 #endif 178 74 … … 199 95 CALL wrk_alloc( jpi, jpj, ztabramp ) 200 96 201 ispongearea = 2 + 2* Agrif_irhox()97 ispongearea = 2 + nn_sponge_len * Agrif_irhox() 202 98 ilci = nlci - ispongearea 203 99 ilcj = nlcj - ispongearea 204 100 z1spongearea = 1._wp / REAL( ispongearea - 2 ) 205 spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:) ) 206 207 ztabramp(:,:) = 0. 101 102 ztabramp(:,:) = 0._wp 208 103 209 104 IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN … … 254 149 ! Tracers 255 150 IF( .NOT. spongedoneT ) THEN 256 spe1ur(:,:) = 0. 257 spe2vr(:,:) = 0. 258 259 IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN 260 spe1ur(2:ispongearea-1,: ) = visc_tra & 261 & * 0.5 * ( ztabramp(2:ispongearea-1,: ) & 262 & + ztabramp(3:ispongearea ,: ) ) & 263 & * e2u(2:ispongearea-1,:) / e1u(2:ispongearea-1,:) 264 265 spe2vr(2:ispongearea ,1:jpjm1 ) = visc_tra & 266 & * 0.5 * ( ztabramp(2:ispongearea ,1:jpjm1) & 267 & + ztabramp(2:ispongearea,2 :jpj ) ) & 268 & * e1v(2:ispongearea,1:jpjm1) / e2v(2:ispongearea,1:jpjm1) 269 ENDIF 270 271 IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN 272 spe1ur(ilci+1:nlci-2,: ) = visc_tra & 273 & * 0.5 * ( ztabramp(ilci+1:nlci-2,: ) & 274 & + ztabramp(ilci+2:nlci-1,: ) ) & 275 & * e2u(ilci+1:nlci-2,:) / e1u(ilci+1:nlci-2,:) 276 277 spe2vr(ilci+1:nlci-1,1:jpjm1 ) = visc_tra & 278 & * 0.5 * ( ztabramp(ilci+1:nlci-1,1:jpjm1) & 279 & + ztabramp(ilci+1:nlci-1,2:jpj ) ) & 280 & * e1v(ilci+1:nlci-1,1:jpjm1) / e2v(ilci+1:nlci-1,1:jpjm1) 281 ENDIF 282 283 IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN 284 spe1ur(1:jpim1,2:ispongearea ) = visc_tra & 285 & * 0.5 * ( ztabramp(1:jpim1,2:ispongearea ) & 286 & + ztabramp(2:jpi ,2:ispongearea ) ) & 287 & * e2u(1:jpim1,2:ispongearea) / e1u(1:jpim1,2:ispongearea) 288 289 spe2vr(: ,2:ispongearea-1) = visc_tra & 290 & * 0.5 * ( ztabramp(: ,2:ispongearea-1) & 291 & + ztabramp(: ,3:ispongearea ) ) & 292 & * e1v(:,2:ispongearea-1) / e2v(:,2:ispongearea-1) 293 ENDIF 294 295 IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN 296 spe1ur(1:jpim1,ilcj+1:nlcj-1) = visc_tra & 297 & * 0.5 * ( ztabramp(1:jpim1,ilcj+1:nlcj-1) & 298 & + ztabramp(2:jpi ,ilcj+1:nlcj-1) ) & 299 & * e2u(1:jpim1,ilcj+1:nlcj-1) / e1u(1:jpim1,ilcj+1:nlcj-1) 300 301 spe2vr(: ,ilcj+1:nlcj-2) = visc_tra & 302 & * 0.5 * ( ztabramp(: ,ilcj+1:nlcj-2) & 303 & + ztabramp(: ,ilcj+2:nlcj-1) ) & 304 & * e1v(:,ilcj+1:nlcj-2) / e2v(:,ilcj+1:nlcj-2) 305 ENDIF 151 fsaht_spu(:,:) = 0._wp 152 fsaht_spv(:,:) = 0._wp 153 DO jj = 2, jpjm1 154 DO ji = 2, jpim1 ! vector opt. 155 fsaht_spu(ji,jj) = 0.5_wp * visc_tra * (ztabramp(ji,jj) + ztabramp(ji+1,jj )) 156 fsaht_spv(ji,jj) = 0.5_wp * visc_tra * (ztabramp(ji,jj) + ztabramp(ji ,jj+1)) 157 END DO 158 END DO 159 160 CALL lbc_lnk( fsaht_spu, 'U', 1. ) ! Lateral boundary conditions 161 CALL lbc_lnk( fsaht_spv, 'V', 1. ) 306 162 spongedoneT = .TRUE. 307 163 ENDIF … … 309 165 ! Dynamics 310 166 IF( .NOT. spongedoneU ) THEN 311 spe1ur2(:,:) = 0. 312 spe2vr2(:,:) = 0. 313 314 IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN 315 spe1ur2(2:ispongearea-1,: ) = visc_dyn & 316 & * 0.5 * ( ztabramp(2:ispongearea-1,: ) & 317 & + ztabramp(3:ispongearea ,: ) ) 318 spe2vr2(2:ispongearea ,1:jpjm1) = visc_dyn & 319 & * 0.5 * ( ztabramp(2:ispongearea ,1:jpjm1) & 320 & + ztabramp(2:ispongearea ,2:jpj ) ) 321 ENDIF 322 323 IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN 324 spe1ur2(ilci+1:nlci-2 ,: ) = visc_dyn & 325 & * 0.5 * ( ztabramp(ilci+1:nlci-2, : ) & 326 & + ztabramp(ilci+2:nlci-1, : ) ) 327 spe2vr2(ilci+1:nlci-1 ,1:jpjm1) = visc_dyn & 328 & * 0.5 * ( ztabramp(ilci+1:nlci-1,1:jpjm1 ) & 329 & + ztabramp(ilci+1:nlci-1,2:jpj ) ) 330 ENDIF 331 332 IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN 333 spe1ur2(1:jpim1,2:ispongearea ) = visc_dyn & 334 & * 0.5 * ( ztabramp(1:jpim1,2:ispongearea ) & 335 & + ztabramp(2:jpi ,2:ispongearea ) ) 336 spe2vr2(: ,2:ispongearea-1) = visc_dyn & 337 & * 0.5 * ( ztabramp(: ,2:ispongearea-1) & 338 & + ztabramp(: ,3:ispongearea ) ) 339 ENDIF 340 341 IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN 342 spe1ur2(1:jpim1,ilcj+1:nlcj-1 ) = visc_dyn & 343 & * 0.5 * ( ztabramp(1:jpim1,ilcj+1:nlcj-1 ) & 344 & + ztabramp(2:jpi ,ilcj+1:nlcj-1 ) ) 345 spe2vr2(: ,ilcj+1:nlcj-2 ) = visc_dyn & 346 & * 0.5 * ( ztabramp(: ,ilcj+1:nlcj-2 ) & 347 & + ztabramp(: ,ilcj+2:nlcj-1 ) ) 348 ENDIF 167 fsahm_spt(:,:) = 0._wp 168 fsahm_spf(:,:) = 0._wp 169 DO jj = 2, jpjm1 170 DO ji = 2, jpim1 ! vector opt. 171 fsahm_spt(ji,jj) = visc_dyn * ztabramp(ji,jj) 172 fsahm_spf(ji,jj) = 0.25_wp * visc_dyn * ( ztabramp(ji,jj) + ztabramp(ji ,jj+1) & 173 & +ztabramp(ji,jj) + ztabramp(ji+1,jj ) ) 174 END DO 175 END DO 176 177 CALL lbc_lnk( fsahm_spt, 'T', 1. ) ! Lateral boundary conditions 178 CALL lbc_lnk( fsahm_spf, 'F', 1. ) 349 179 spongedoneU = .TRUE. 350 spbtr3(:,:) = 1. / ( e1f(:,:) * e2f(:,:) )351 180 ENDIF 352 181 ! … … 357 186 END SUBROUTINE Agrif_Sponge 358 187 359 SUBROUTINE interptsn (tabres,i1,i2,j1,j2,k1,k2,n1,n2)360 !!--------------------------------------------- 361 !! *** ROUTINE interptsn ***188 SUBROUTINE interptsn_sponge(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before) 189 !!--------------------------------------------- 190 !! *** ROUTINE interptsn_sponge *** 362 191 !!--------------------------------------------- 363 192 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 364 193 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 365 366 tabres(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2) 367 368 END SUBROUTINE interptsn 369 370 SUBROUTINE interpun(tabres,i1,i2,j1,j2,k1,k2) 371 !!--------------------------------------------- 372 !! *** ROUTINE interpun *** 373 !!--------------------------------------------- 194 LOGICAL, INTENT(in) :: before 195 196 197 INTEGER :: ji, jj, jk, jn ! dummy loop indices 198 INTEGER :: iku, ikv 199 REAL(wp) :: ztsa, zabe1, zabe2, zbtr 200 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ztu, ztv 201 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::tsbdiff 202 ! 203 IF (before) THEN 204 tabres(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2) 205 ELSE 206 207 tsbdiff(:,:,:,:) = tsb(i1:i2,j1:j2,:,:) - tabres(:,:,:,:) 208 DO jn = 1, jpts 209 DO jk = 1, jpkm1 210 DO jj = j1,j2-1 211 DO ji = i1,i2-1 212 zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk) 213 zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk) 214 ztu(ji,jj,jk) = zabe1 * ( tsbdiff(ji+1,jj ,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 215 ztv(ji,jj,jk) = zabe2 * ( tsbdiff(ji ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 216 ENDDO 217 ENDDO 218 219 IF( ln_zps ) THEN ! set gradient at partial step level 220 DO jj = j1,j2-1 221 DO ji = i1,i2-1 222 ! last level 223 iku = mbku(ji,jj) 224 ikv = mbkv(ji,jj) 225 IF( iku == jk ) THEN 226 ztu(ji,jj,jk) = 0._wp 227 ENDIF 228 IF( ikv == jk ) THEN 229 ztv(ji,jj,jk) = 0._wp 230 ENDIF 231 END DO 232 END DO 233 ENDIF 234 ENDDO 235 236 DO jk = 1, jpkm1 237 DO jj = j1+1,j2-1 238 DO ji = i1+1,i2-1 239 240 IF (.NOT. tabspongedone_tsn(ji,jj)) THEN 241 zbtr = r1_e12t(ji,jj) / fse3t_n(ji,jj,jk) 242 ! horizontal diffusive trends 243 ztsa = zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji ,jj-1,jk) ) 244 ! add it to the general tracer trends 245 tsa(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) + ztsa 246 ENDIF 247 248 ENDDO 249 ENDDO 250 251 ENDDO 252 ENDDO 253 254 tabspongedone_tsn(i1+1:i2-1,j1+1:j2-1) = .TRUE. 255 256 ENDIF 257 258 END SUBROUTINE interptsn_sponge 259 260 SUBROUTINE interpun_sponge(tabres,i1,i2,j1,j2,k1,k2, before) 261 !!--------------------------------------------- 262 !! *** ROUTINE interpun_sponge *** 263 !!--------------------------------------------- 374 264 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 375 265 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 376 377 tabres(i1:i2,j1:j2,k1:k2) = un(i1:i2,j1:j2,k1:k2) 378 379 END SUBROUTINE interpun 380 381 SUBROUTINE interpvn(tabres,i1,i2,j1,j2,k1,k2) 382 !!--------------------------------------------- 383 !! *** ROUTINE interpvn *** 384 !!--------------------------------------------- 266 LOGICAL, INTENT(in) :: before 267 268 INTEGER :: ji,jj,jk 269 270 ! sponge parameters 271 REAL(wp) :: ze2u, ze1v, zua, zva, zbtr 272 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ubdiff 273 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: rotdiff, hdivdiff 274 INTEGER :: jmax 275 ! 276 277 278 IF (before) THEN 279 tabres = un(i1:i2,j1:j2,:) 280 ELSE 281 282 ubdiff(i1:i2,j1:j2,:) = (ub(i1:i2,j1:j2,:) - tabres(:,:,:))*umask(i1:i2,j1:j2,:) 283 284 DO jk = 1, jpkm1 ! Horizontal slab 285 ! ! =============== 286 287 ! ! -------- 288 ! Horizontal divergence ! div 289 ! ! -------- 290 DO jj = j1,j2 291 DO ji = i1+1,i2 ! vector opt. 292 zbtr = r1_e12t(ji,jj) / fse3t_n(ji,jj,jk) * fsahm_spt(ji,jj) 293 hdivdiff(ji,jj,jk) = ( e2u(ji ,jj)*fse3u_n(ji ,jj,jk) * ubdiff(ji ,jj,jk) & 294 & -e2u(ji-1,jj)*fse3u_n(ji-1,jj,jk) * ubdiff(ji-1,jj,jk) ) * zbtr 295 END DO 296 END DO 297 298 DO jj = j1,j2-1 299 DO ji = i1,i2 ! vector opt. 300 zbtr = r1_e12f(ji,jj) * fse3f_n(ji,jj,jk) * fsahm_spf(ji,jj) 301 rotdiff(ji,jj,jk) = (-e1u(ji,jj+1) * ubdiff(ji,jj+1,jk) & 302 +e1u(ji,jj ) * ubdiff(ji,jj ,jk) & 303 & ) * fmask(ji,jj,jk) * zbtr 304 END DO 305 END DO 306 ENDDO 307 308 ! 309 310 311 312 DO jj = j1+1, j2-1 313 DO ji = i1+1, i2-1 ! vector opt. 314 315 IF (.NOT. tabspongedone_u(ji,jj)) THEN 316 DO jk = 1, jpkm1 ! Horizontal slab 317 ze2u = rotdiff (ji,jj,jk) 318 ze1v = hdivdiff(ji,jj,jk) 319 ! horizontal diffusive trends 320 zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * fse3u_n(ji,jj,jk) ) & 321 + ( hdivdiff(ji+1,jj,jk) - ze1v ) / e1u(ji,jj) 322 323 ! add it to the general momentum trends 324 ua(ji,jj,jk) = ua(ji,jj,jk) + zua 325 326 END DO 327 ENDIF 328 329 END DO 330 END DO 331 332 tabspongedone_u(i1+1:i2-1,j1+1:j2-1) = .TRUE. 333 334 jmax = j2-1 335 IF ((nbondj == 1).OR.(nbondj == 2)) jmax = MIN(jmax,nlcj-3) 336 337 DO jj = j1+1, jmax 338 DO ji = i1+1, i2 ! vector opt. 339 340 IF (.NOT. tabspongedone_v(ji,jj)) THEN 341 DO jk = 1, jpkm1 ! Horizontal slab 342 ze2u = rotdiff (ji,jj,jk) 343 ze1v = hdivdiff(ji,jj,jk) 344 345 ! horizontal diffusive trends 346 zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * fse3v_n(ji,jj,jk) ) & 347 + ( hdivdiff(ji,jj+1,jk) - ze1v ) / e2v(ji,jj) 348 349 ! add it to the general momentum trends 350 va(ji,jj,jk) = va(ji,jj,jk) + zva 351 END DO 352 ENDIF 353 354 END DO 355 END DO 356 357 358 tabspongedone_v(i1+1:i2,j1+1:jmax) = .TRUE. 359 360 ENDIF 361 362 363 END SUBROUTINE interpun_sponge 364 365 366 SUBROUTINE interpvn_sponge(tabres,i1,i2,j1,j2,k1,k2, before,nb,ndir) 367 !!--------------------------------------------- 368 !! *** ROUTINE interpvn_sponge *** 369 !!--------------------------------------------- 385 370 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 386 371 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 387 388 tabres(i1:i2,j1:j2,k1:k2) = vn(i1:i2,j1:j2,k1:k2) 389 390 END SUBROUTINE interpvn 372 LOGICAL, INTENT(in) :: before 373 INTEGER, INTENT(in) :: nb , ndir 374 375 INTEGER :: ji,jj,jk 376 377 REAL(wp) :: ze2u, ze1v, zua, zva, zbtr 378 379 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: vbdiff 380 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: rotdiff, hdivdiff 381 INTEGER :: imax 382 ! 383 384 IF (before) THEN 385 tabres = vn(i1:i2,j1:j2,:) 386 ELSE 387 388 vbdiff(i1:i2,j1:j2,:) = (vb(i1:i2,j1:j2,:) - tabres(:,:,:))*vmask(i1:i2,j1:j2,:) 389 390 DO jk = 1, jpkm1 ! Horizontal slab 391 ! ! =============== 392 393 ! ! -------- 394 ! Horizontal divergence ! div 395 ! ! -------- 396 DO jj = j1+1,j2 397 DO ji = i1,i2 ! vector opt. 398 zbtr = r1_e12t(ji,jj) / fse3t_n(ji,jj,jk) * fsahm_spt(ji,jj) 399 hdivdiff(ji,jj,jk) = ( e1v(ji,jj ) * fse3v(ji,jj ,jk) * vbdiff(ji,jj ,jk) & 400 & -e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * vbdiff(ji,jj-1,jk) ) * zbtr 401 END DO 402 END DO 403 DO jj = j1,j2 404 DO ji = i1,i2-1 ! vector opt. 405 zbtr = r1_e12f(ji,jj) * fse3f_n(ji,jj,jk) * fsahm_spf(ji,jj) 406 rotdiff(ji,jj,jk) = ( e2v(ji+1,jj) * vbdiff(ji+1,jj,jk) & 407 & -e2v(ji ,jj) * vbdiff(ji ,jj,jk) & 408 & ) * fmask(ji,jj,jk) * zbtr 409 END DO 410 END DO 411 ENDDO 412 413 ! ! =============== 414 ! 415 416 imax = i2-1 417 IF ((nbondi == 1).OR.(nbondi == 2)) imax = MIN(imax,nlci-3) 418 419 DO jj = j1+1, j2 420 DO ji = i1+1, imax ! vector opt. 421 IF (.NOT. tabspongedone_u(ji,jj)) THEN 422 DO jk = 1, jpkm1 ! Horizontal slab 423 ze2u = rotdiff (ji,jj,jk) 424 ze1v = hdivdiff(ji,jj,jk) 425 ! horizontal diffusive trends 426 zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * fse3u_n(ji,jj,jk) ) + ( hdivdiff(ji+1,jj,jk) - ze1v) & 427 / e1u(ji,jj) 428 429 430 ! add it to the general momentum trends 431 ua(ji,jj,jk) = ua(ji,jj,jk) + zua 432 END DO 433 434 ENDIF 435 END DO 436 END DO 437 438 tabspongedone_u(i1+1:imax,j1+1:j2) = .TRUE. 439 440 DO jj = j1+1, j2-1 441 DO ji = i1+1, i2-1 ! vector opt. 442 IF (.NOT. tabspongedone_v(ji,jj)) THEN 443 DO jk = 1, jpkm1 ! Horizontal slab 444 ze2u = rotdiff (ji,jj,jk) 445 ze1v = hdivdiff(ji,jj,jk) 446 ! horizontal diffusive trends 447 448 zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * fse3v_n(ji,jj,jk) ) + ( hdivdiff(ji,jj+1,jk) - ze1v) & 449 / e2v(ji,jj) 450 451 ! add it to the general momentum trends 452 va(ji,jj,jk) = va(ji,jj,jk) + zva 453 END DO 454 ENDIF 455 END DO 456 END DO 457 tabspongedone_v(i1+1:i2-1,j1+1:j2-1) = .TRUE. 458 ENDIF 459 460 END SUBROUTINE interpvn_sponge 391 461 392 462 #else -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90
r4491 r6204 1 #define TWO_WAY 2 1 #define TWO_WAY /* TWO WAY NESTING */ 2 #undef DECAL_FEEDBACK /* SEPARATION of INTERFACES*/ 3 3 4 MODULE agrif_opa_update 4 5 #if defined key_agrif && ! defined key_offline … … 11 12 USE wrk_nemo 12 13 USE dynspg_oce 14 USE zdf_oce ! vertical physics: ocean variables 13 15 14 16 IMPLICIT NONE 15 17 PRIVATE 16 18 17 PUBLIC Agrif_Update_Tra, Agrif_Update_Dyn 18 19 INTEGER, PUBLIC :: nbcline = 020 19 PUBLIC Agrif_Update_Tra, Agrif_Update_Dyn,Update_Scales 20 # if defined key_zdftke 21 PUBLIC Agrif_Update_Tke 22 # endif 21 23 !!---------------------------------------------------------------------- 22 !! NEMO/NST 3. 3, NEMO Consortium (2010)24 !! NEMO/NST 3.6 , NEMO Consortium (2010) 23 25 !! $Id$ 24 26 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 27 29 CONTAINS 28 30 29 SUBROUTINE Agrif_Update_Tra( kt)31 RECURSIVE SUBROUTINE Agrif_Update_Tra( ) 30 32 !!--------------------------------------------- 31 33 !! *** ROUTINE Agrif_Update_Tra *** 32 34 !!--------------------------------------------- 33 !! 34 INTEGER, INTENT(in) :: kt 35 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab 36 37 38 IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN 39 #if defined TWO_WAY 40 CALL wrk_alloc( jpi, jpj, jpk, jpts, ztab ) 35 ! 36 IF (Agrif_Root()) RETURN 37 ! 38 #if defined TWO_WAY 39 IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update tracers from grid Number',Agrif_Fixed(), 'nbcline', nbcline 41 40 42 41 Agrif_UseSpecialValueInUpdate = .TRUE. 43 42 Agrif_SpecialValueFineGrid = 0. 44 43 ! 45 44 IF (MOD(nbcline,nbclineupdate) == 0) THEN 46 CALL Agrif_Update_Variable(ztab,tsn_id, procname=updateTS) 47 ELSE 48 CALL Agrif_Update_Variable(ztab,tsn_id,locupdate=(/0,2/), procname=updateTS) 49 ENDIF 50 45 # if ! defined DECAL_FEEDBACK 46 CALL Agrif_Update_Variable(tsn_id, procname=updateTS) 47 # else 48 CALL Agrif_Update_Variable(tsn_id, locupdate=(/1,0/),procname=updateTS) 49 # endif 50 ELSE 51 # if ! defined DECAL_FEEDBACK 52 CALL Agrif_Update_Variable(tsn_id,locupdate=(/0,2/), procname=updateTS) 53 # else 54 CALL Agrif_Update_Variable(tsn_id,locupdate=(/1,2/), procname=updateTS) 55 # endif 56 ENDIF 57 ! 51 58 Agrif_UseSpecialValueInUpdate = .FALSE. 52 53 CALL wrk_dealloc( jpi, jpj, jpk, jpts, ztab ) 59 ! 60 IF ( lk_agrif_doupd ) THEN ! Initialisation: do recursive update: 61 CALL Agrif_ChildGrid_To_ParentGrid() 62 CALL Agrif_Update_Tra() 63 CALL Agrif_ParentGrid_To_ChildGrid() 64 ENDIF 65 ! 54 66 #endif 55 67 ! 56 68 END SUBROUTINE Agrif_Update_Tra 57 69 58 SUBROUTINE Agrif_Update_Dyn( kt)70 RECURSIVE SUBROUTINE Agrif_Update_Dyn( ) 59 71 !!--------------------------------------------- 60 72 !! *** ROUTINE Agrif_Update_Dyn *** 61 73 !!--------------------------------------------- 62 !! 63 INTEGER, INTENT(in) :: kt 64 REAL(wp), POINTER, DIMENSION(:,:) :: ztab2d 65 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztab 66 67 68 IF ((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) Return 74 ! 75 IF (Agrif_Root()) RETURN 76 ! 69 77 #if defined TWO_WAY 70 CALL wrk_alloc( jpi, jpj, ztab2d ) 71 CALL wrk_alloc( jpi, jpj, jpk, ztab ) 72 78 IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update momentum from grid Number',Agrif_Fixed(), 'nbcline', nbcline 79 80 Agrif_UseSpecialValueInUpdate = .FALSE. 81 Agrif_SpecialValueFineGrid = 0. 82 ! 73 83 IF (mod(nbcline,nbclineupdate) == 0) THEN 74 CALL Agrif_Update_Variable(ztab,un_id,procname = updateU) 75 CALL Agrif_Update_Variable(ztab,vn_id,procname = updateV) 76 ELSE 77 CALL Agrif_Update_Variable(ztab,un_id,locupdate=(/0,1/),procname = updateU) 78 CALL Agrif_Update_Variable(ztab,vn_id,locupdate=(/0,1/),procname = updateV) 79 ENDIF 80 81 CALL Agrif_Update_Variable(ztab2d,e1u_id,procname = updateU2d) 82 CALL Agrif_Update_Variable(ztab2d,e2v_id,procname = updateV2d) 83 84 #if defined key_dynspg_ts 84 # if ! defined DECAL_FEEDBACK 85 CALL Agrif_Update_Variable(un_update_id,procname = updateU) 86 CALL Agrif_Update_Variable(vn_update_id,procname = updateV) 87 # else 88 CALL Agrif_Update_Variable(un_update_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateU) 89 CALL Agrif_Update_Variable(vn_update_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updateV) 90 # endif 91 ELSE 92 # if ! defined DECAL_FEEDBACK 93 CALL Agrif_Update_Variable(un_update_id,locupdate=(/0,1/),procname = updateU) 94 CALL Agrif_Update_Variable(vn_update_id,locupdate=(/0,1/),procname = updateV) 95 # else 96 CALL Agrif_Update_Variable(un_update_id,locupdate1=(/0,1/),locupdate2=(/1,1/),procname = updateU) 97 CALL Agrif_Update_Variable(vn_update_id,locupdate1=(/1,1/),locupdate2=(/0,1/),procname = updateV) 98 # endif 99 ENDIF 100 101 # if ! defined DECAL_FEEDBACK 102 CALL Agrif_Update_Variable(e1u_id,procname = updateU2d) 103 CALL Agrif_Update_Variable(e2v_id,procname = updateV2d) 104 # else 105 CALL Agrif_Update_Variable(e1u_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateU2d) 106 CALL Agrif_Update_Variable(e2v_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updateV2d) 107 # endif 108 109 # if defined key_dynspg_ts 85 110 IF (ln_bt_fw) THEN 86 111 ! Update time integrated transports 87 112 IF (mod(nbcline,nbclineupdate) == 0) THEN 88 CALL Agrif_Update_Variable(ztab2d,ub2b_id,procname = updateub2b) 89 CALL Agrif_Update_Variable(ztab2d,vb2b_id,procname = updatevb2b) 113 # if ! defined DECAL_FEEDBACK 114 CALL Agrif_Update_Variable(ub2b_update_id,procname = updateub2b) 115 CALL Agrif_Update_Variable(vb2b_update_id,procname = updatevb2b) 116 # else 117 CALL Agrif_Update_Variable(ub2b_update_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateub2b) 118 CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updatevb2b) 119 # endif 90 120 ELSE 91 CALL Agrif_Update_Variable(ztab2d,ub2b_id,locupdate=(/0,1/),procname = updateub2b) 92 CALL Agrif_Update_Variable(ztab2d,vb2b_id,locupdate=(/0,1/),procname = updatevb2b) 121 # if ! defined DECAL_FEEDBACK 122 CALL Agrif_Update_Variable(ub2b_update_id,locupdate=(/0,1/),procname = updateub2b) 123 CALL Agrif_Update_Variable(vb2b_update_id,locupdate=(/0,1/),procname = updatevb2b) 124 # else 125 CALL Agrif_Update_Variable(ub2b_update_id,locupdate1=(/0,1/),locupdate2=(/1,1/),procname = updateub2b) 126 CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/1,1/),locupdate2=(/0,1/),procname = updatevb2b) 127 # endif 93 128 ENDIF 94 END IF 129 END IF 130 # endif 131 ! 132 nbcline = nbcline + 1 133 ! 134 Agrif_UseSpecialValueInUpdate = .TRUE. 135 Agrif_SpecialValueFineGrid = 0. 136 # if ! defined DECAL_FEEDBACK 137 CALL Agrif_Update_Variable(sshn_id,procname = updateSSH) 138 # else 139 CALL Agrif_Update_Variable(sshn_id,locupdate=(/1,0/),procname = updateSSH) 140 # endif 141 Agrif_UseSpecialValueInUpdate = .FALSE. 142 ! 95 143 #endif 96 97 nbcline = nbcline + 1 98 99 Agrif_UseSpecialValueInUpdate = .TRUE. 144 ! 145 ! Do recursive update: 146 IF ( lk_agrif_doupd ) THEN ! Initialisation: do recursive update: 147 CALL Agrif_ChildGrid_To_ParentGrid() 148 CALL Agrif_Update_Dyn() 149 CALL Agrif_ParentGrid_To_ChildGrid() 150 ENDIF 151 ! 152 END SUBROUTINE Agrif_Update_Dyn 153 154 # if defined key_zdftke 155 SUBROUTINE Agrif_Update_Tke( kt ) 156 !!--------------------------------------------- 157 !! *** ROUTINE Agrif_Update_Tke *** 158 !!--------------------------------------------- 159 !! 160 INTEGER, INTENT(in) :: kt 161 ! 162 IF( ( Agrif_NbStepint() .NE. 0 ) .AND. (kt /= 0) ) RETURN 163 # if defined TWO_WAY 164 165 Agrif_UseSpecialValueInUpdate = .TRUE. 100 166 Agrif_SpecialValueFineGrid = 0. 101 CALL Agrif_Update_Variable(ztab2d,sshn_id,procname = updateSSH) 167 168 CALL Agrif_Update_Variable( en_id, locupdate=(/0,0/), procname=updateEN ) 169 CALL Agrif_Update_Variable(avt_id, locupdate=(/0,0/), procname=updateAVT ) 170 CALL Agrif_Update_Variable(avm_id, locupdate=(/0,0/), procname=updateAVM ) 171 102 172 Agrif_UseSpecialValueInUpdate = .FALSE. 103 173 104 CALL wrk_dealloc( jpi, jpj, ztab2d ) 105 CALL wrk_dealloc( jpi, jpj, jpk, ztab ) 106 107 !Done in step 108 ! CALL Agrif_ChildGrid_To_ParentGrid() 109 ! CALL recompute_diags( kt ) 110 ! CALL Agrif_ParentGrid_To_ChildGrid() 111 112 #endif 113 114 END SUBROUTINE Agrif_Update_Dyn 115 116 SUBROUTINE recompute_diags( kt ) 117 !!--------------------------------------------- 118 !! *** ROUTINE recompute_diags *** 119 !!--------------------------------------------- 120 INTEGER, INTENT(in) :: kt 121 122 END SUBROUTINE recompute_diags 174 # endif 175 176 END SUBROUTINE Agrif_Update_Tke 177 # endif /* key_zdftke */ 123 178 124 179 SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) … … 127 182 !!--------------------------------------------- 128 183 # include "domzgr_substitute.h90" 129 130 184 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 131 185 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 132 LOGICAL, iNTENT(in) :: before133 186 LOGICAL, INTENT(in) :: before 187 !! 134 188 INTEGER :: ji,jj,jk,jn 135 189 !!--------------------------------------------- 190 ! 136 191 IF (before) THEN 137 192 DO jn = n1,n2 … … 146 201 ELSE 147 202 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 148 ! Add asselin part203 ! Add asselin part 149 204 DO jn = n1,n2 150 205 DO jk=k1,k2 … … 153 208 IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN 154 209 tsb(ji,jj,jk,jn) = tsb(ji,jj,jk,jn) & 155 & + atfp * ( tabres(ji,jj,jk,jn) &156 & - tsn(ji,jj,jk,jn) ) * tmask(ji,jj,jk)210 & + atfp * ( tabres(ji,jj,jk,jn) & 211 & - tsn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 157 212 ENDIF 158 213 ENDDO … … 161 216 ENDDO 162 217 ENDIF 163 164 218 DO jn = n1,n2 165 219 DO jk=k1,k2 … … 174 228 END DO 175 229 ENDIF 176 230 ! 177 231 END SUBROUTINE updateTS 178 232 … … 182 236 !!--------------------------------------------- 183 237 # include "domzgr_substitute.h90" 184 238 !! 185 239 INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 186 240 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 187 241 LOGICAL, INTENT(in) :: before 188 242 !! 189 243 INTEGER :: ji, jj, jk 190 244 REAL(wp) :: zrhoy 191 245 !!--------------------------------------------- 246 ! 192 247 IF (before) THEN 193 248 zrhoy = Agrif_Rhoy() … … 209 264 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 210 265 ub(ji,jj,jk) = ub(ji,jj,jk) & 211 & + atfp * ( tabres(ji,jj,jk) - un(ji,jj,jk) ) * umask(ji,jj,jk)266 & + atfp * ( tabres(ji,jj,jk) - un(ji,jj,jk) ) * umask(ji,jj,jk) 212 267 ENDIF 213 268 ! … … 217 272 END DO 218 273 ENDIF 219 274 ! 220 275 END SUBROUTINE updateu 221 276 … … 225 280 !!--------------------------------------------- 226 281 # include "domzgr_substitute.h90" 227 282 !! 228 283 INTEGER :: i1,i2,j1,j2,k1,k2 229 284 INTEGER :: ji,jj,jk 230 285 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: tabres 231 286 LOGICAL :: before 232 287 !! 233 288 REAL(wp) :: zrhox 234 289 !!--------------------------------------------- 290 ! 235 291 IF (before) THEN 236 292 zrhox = Agrif_Rhox() … … 252 308 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 253 309 vb(ji,jj,jk) = vb(ji,jj,jk) & 254 & + atfp * ( tabres(ji,jj,jk) - vn(ji,jj,jk) ) * vmask(ji,jj,jk)310 & + atfp * ( tabres(ji,jj,jk) - vn(ji,jj,jk) ) * vmask(ji,jj,jk) 255 311 ENDIF 256 312 ! … … 260 316 END DO 261 317 ENDIF 262 318 ! 263 319 END SUBROUTINE updatev 264 320 … … 268 324 !!--------------------------------------------- 269 325 # include "domzgr_substitute.h90" 270 326 !! 271 327 INTEGER, INTENT(in) :: i1, i2, j1, j2 272 328 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 273 329 LOGICAL, INTENT(in) :: before 274 330 !! 275 331 INTEGER :: ji, jj, jk 276 332 REAL(wp) :: zrhoy 277 333 REAL(wp) :: zcorr 278 334 !!--------------------------------------------- 335 ! 279 336 IF (before) THEN 280 337 zrhoy = Agrif_Rhoy() … … 326 383 END DO 327 384 ENDIF 328 385 ! 329 386 END SUBROUTINE updateu2d 330 387 … … 333 390 !! *** ROUTINE updatev2d *** 334 391 !!--------------------------------------------- 335 336 392 INTEGER, INTENT(in) :: i1, i2, j1, j2 337 393 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 338 394 LOGICAL, INTENT(in) :: before 339 395 !! 340 396 INTEGER :: ji, jj, jk 341 397 REAL(wp) :: zrhox 342 398 REAL(wp) :: zcorr 343 399 !!--------------------------------------------- 400 ! 344 401 IF (before) THEN 345 402 zrhox = Agrif_Rhox() … … 391 448 END DO 392 449 ENDIF 393 450 ! 394 451 END SUBROUTINE updatev2d 395 452 453 396 454 SUBROUTINE updateSSH( tabres, i1, i2, j1, j2, before ) 397 455 !!--------------------------------------------- 398 456 !! *** ROUTINE updateSSH *** 399 457 !!--------------------------------------------- 400 # include "domzgr_substitute.h90"401 402 458 INTEGER, INTENT(in) :: i1, i2, j1, j2 403 459 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 404 460 LOGICAL, INTENT(in) :: before 405 461 !! 406 462 INTEGER :: ji, jj 407 463 !!--------------------------------------------- 464 ! 408 465 IF (before) THEN 409 466 DO jj=j1,j2 … … 413 470 END DO 414 471 ELSE 415 416 472 #if ! defined key_dynspg_ts 417 473 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 418 474 DO jj=j1,j2 419 475 DO ji=i1,i2 420 sshb(ji,jj) = sshb(ji,jj) &421 & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1)476 sshb(ji,jj) = sshb(ji,jj) & 477 & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1) 422 478 END DO 423 479 END DO … … 430 486 END DO 431 487 ENDIF 432 488 ! 433 489 END SUBROUTINE updateSSH 434 490 … … 437 493 !! *** ROUTINE updateub2b *** 438 494 !!--------------------------------------------- 439 440 495 INTEGER, INTENT(in) :: i1, i2, j1, j2 441 496 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 442 497 LOGICAL, INTENT(in) :: before 443 498 !! 444 499 INTEGER :: ji, jj 445 500 REAL(wp) :: zrhoy 446 501 !!--------------------------------------------- 502 ! 447 503 IF (before) THEN 448 504 zrhoy = Agrif_Rhoy() … … 460 516 END DO 461 517 ENDIF 462 518 ! 463 519 END SUBROUTINE updateub2b 464 520 … … 467 523 !! *** ROUTINE updatevb2b *** 468 524 !!--------------------------------------------- 469 470 525 INTEGER, INTENT(in) :: i1, i2, j1, j2 471 526 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 472 527 LOGICAL, INTENT(in) :: before 473 528 !! 474 529 INTEGER :: ji, jj 475 530 REAL(wp) :: zrhox 476 531 !!--------------------------------------------- 532 ! 477 533 IF (before) THEN 478 534 zrhox = Agrif_Rhox() … … 490 546 END DO 491 547 ENDIF 492 548 ! 493 549 END SUBROUTINE updatevb2b 550 551 552 SUBROUTINE update_scales( tabres, i1, i2, j1, j2, k1, k2, n1,n2, before ) 553 ! currently not used 554 !!--------------------------------------------- 555 !! *** ROUTINE updateT *** 556 !!--------------------------------------------- 557 # include "domzgr_substitute.h90" 558 559 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 560 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 561 LOGICAL, iNTENT(in) :: before 562 563 INTEGER :: ji,jj,jk 564 REAL(wp) :: ztemp 565 566 IF (before) THEN 567 DO jk=k1,k2 568 DO jj=j1,j2 569 DO ji=i1,i2 570 tabres(ji,jj,jk,1) = e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,jk) 571 tabres(ji,jj,jk,2) = e1t(ji,jj)*tmask(ji,jj,jk) 572 tabres(ji,jj,jk,3) = e2t(ji,jj)*tmask(ji,jj,jk) 573 END DO 574 END DO 575 END DO 576 tabres(:,:,:,1)=tabres(:,:,:,1)*Agrif_Rhox()*Agrif_Rhoy() 577 tabres(:,:,:,2)=tabres(:,:,:,2)*Agrif_Rhox() 578 tabres(:,:,:,3)=tabres(:,:,:,3)*Agrif_Rhoy() 579 ELSE 580 DO jk=k1,k2 581 DO jj=j1,j2 582 DO ji=i1,i2 583 IF( tabres(ji,jj,jk,1) .NE. 0. ) THEN 584 print *,'VAL = ',ji,jj,jk,tabres(ji,jj,jk,1),e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,jk) 585 print *,'VAL2 = ',ji,jj,jk,tabres(ji,jj,jk,2),e1t(ji,jj)*tmask(ji,jj,jk) 586 print *,'VAL3 = ',ji,jj,jk,tabres(ji,jj,jk,3),e2t(ji,jj)*tmask(ji,jj,jk) 587 ztemp = sqrt(tabres(ji,jj,jk,1)/(tabres(ji,jj,jk,2)*tabres(ji,jj,jk,3))) 588 print *,'CORR = ',ztemp-1. 589 print *,'NEW VALS = ',tabres(ji,jj,jk,2)*ztemp,tabres(ji,jj,jk,3)*ztemp, & 590 tabres(ji,jj,jk,2)*ztemp*tabres(ji,jj,jk,3)*ztemp 591 e1t(ji,jj) = tabres(ji,jj,jk,2)*ztemp 592 e2t(ji,jj) = tabres(ji,jj,jk,3)*ztemp 593 END IF 594 END DO 595 END DO 596 END DO 597 ENDIF 598 ! 599 END SUBROUTINE update_scales 600 601 # if defined key_zdftke 602 SUBROUTINE updateEN( ptab, i1, i2, j1, j2, k1, k2, before ) 603 !!--------------------------------------------- 604 !! *** ROUTINE updateen *** 605 !!--------------------------------------------- 606 INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 607 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 608 LOGICAL, INTENT(in) :: before 609 !!--------------------------------------------- 610 ! 611 IF (before) THEN 612 ptab (i1:i2,j1:j2,k1:k2) = en(i1:i2,j1:j2,k1:k2) 613 ELSE 614 en(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 615 ENDIF 616 ! 617 END SUBROUTINE updateEN 618 619 620 SUBROUTINE updateAVT( ptab, i1, i2, j1, j2, k1, k2, before ) 621 !!--------------------------------------------- 622 !! *** ROUTINE updateavt *** 623 !!--------------------------------------------- 624 INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 625 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 626 LOGICAL, INTENT(in) :: before 627 !!--------------------------------------------- 628 ! 629 IF (before) THEN 630 ptab (i1:i2,j1:j2,k1:k2) = avt_k(i1:i2,j1:j2,k1:k2) 631 ELSE 632 avt_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 633 ENDIF 634 ! 635 END SUBROUTINE updateAVT 636 637 638 SUBROUTINE updateAVM( ptab, i1, i2, j1, j2, k1, k2, before ) 639 !!--------------------------------------------- 640 !! *** ROUTINE updateavm *** 641 !!--------------------------------------------- 642 INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 643 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 644 LOGICAL, INTENT(in) :: before 645 !!--------------------------------------------- 646 ! 647 IF (before) THEN 648 ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2) 649 ELSE 650 avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 651 ENDIF 652 ! 653 END SUBROUTINE updateAVM 654 655 # endif /* key_zdftke */ 494 656 495 657 #else -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90
r3680 r6204 7 7 USE agrif_oce 8 8 USE agrif_top_sponge 9 USE par_trc 9 10 USE trc 10 11 USE lib_mpp … … 14 15 PRIVATE 15 16 16 PUBLIC Agrif_trc 17 PUBLIC Agrif_trc, interptrn 17 18 18 19 # include "domzgr_substitute.h90" 19 20 # include "vectopt_loop_substitute.h90" 20 21 !!---------------------------------------------------------------------- 21 !! NEMO/NST 3. 3, NEMO Consortium (2010)22 !! NEMO/NST 3.6 , NEMO Consortium (2010) 22 23 !! $Id$ 23 24 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 28 29 SUBROUTINE Agrif_trc 29 30 !!---------------------------------------------------------------------- 30 !! *** ROUTINE Agrif_Tra *** 31 !!---------------------------------------------------------------------- 32 !! 33 INTEGER :: ji, jj, jk, jn ! dummy loop indices 34 REAL(wp) :: zrhox , alpha1, alpha2, alpha3 35 REAL(wp) :: alpha4, alpha5, alpha6, alpha7 36 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztra 31 !! *** ROUTINE Agrif_trc *** 37 32 !!---------------------------------------------------------------------- 38 33 ! 39 34 IF( Agrif_Root() ) RETURN 40 35 41 CALL wrk_alloc( jpi, jpj, jpk, jptra, ztra )42 43 36 Agrif_SpecialValue = 0.e0 44 37 Agrif_UseSpecialValue = .TRUE. 45 ztra(:,:,:,:) = 0.e046 38 47 CALL Agrif_Bc_variable( ztra,trn_id, procname=interptrn )39 CALL Agrif_Bc_variable( trn_id, procname=interptrn ) 48 40 Agrif_UseSpecialValue = .FALSE. 41 ! 42 END SUBROUTINE Agrif_trc 49 43 50 zrhox = Agrif_Rhox() 44 SUBROUTINE interptrn(ptab,i1,i2,j1,j2,k1,k2,n1,n2,before,nb,ndir) 45 !!--------------------------------------------- 46 !! *** ROUTINE interptrn *** 47 !!--------------------------------------------- 48 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab 49 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 50 LOGICAL, INTENT(in) :: before 51 INTEGER, INTENT(in) :: nb , ndir 52 ! 53 INTEGER :: ji, jj, jk, jn ! dummy loop indices 54 INTEGER :: imin, imax, jmin, jmax 55 REAL(wp) :: zrhox , zalpha1, zalpha2, zalpha3 56 REAL(wp) :: zalpha4, zalpha5, zalpha6, zalpha7 57 LOGICAL :: western_side, eastern_side,northern_side,southern_side 51 58 52 alpha1 = ( zrhox - 1. ) * 0.5 53 alpha2 = 1. - alpha1 54 55 alpha3 = ( zrhox - 1. ) / ( zrhox + 1. ) 56 alpha4 = 1. - alpha3 57 58 alpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 59 alpha7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 60 alpha5 = 1. - alpha6 - alpha7 61 IF( nbondi == 1 .OR. nbondi == 2 ) THEN 62 63 DO jn = 1, jptra 64 tra(nlci,:,:,jn) = alpha1 * ztra(nlci,:,:,jn) + alpha2 * ztra(nlci-1,:,:,jn) 65 DO jk = 1, jpkm1 66 DO jj = 1, jpj 67 IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 68 tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 69 ELSE 70 tra(nlci-1,jj,jk,jn)=(alpha4*tra(nlci,jj,jk,jn)+alpha3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 71 IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 72 tra(nlci-1,jj,jk,jn)=( alpha6*tra(nlci-2,jj,jk,jn)+alpha5*tra(nlci,jj,jk,jn) & 73 & + alpha7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 59 IF (before) THEN 60 ptab(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2) 61 ELSE 62 ! 63 western_side = (nb == 1).AND.(ndir == 1) 64 eastern_side = (nb == 1).AND.(ndir == 2) 65 southern_side = (nb == 2).AND.(ndir == 1) 66 northern_side = (nb == 2).AND.(ndir == 2) 67 ! 68 zrhox = Agrif_Rhox() 69 ! 70 zalpha1 = ( zrhox - 1. ) * 0.5 71 zalpha2 = 1. - zalpha1 72 ! 73 zalpha3 = ( zrhox - 1. ) / ( zrhox + 1. ) 74 zalpha4 = 1. - zalpha3 75 ! 76 zalpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 77 zalpha7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 78 zalpha5 = 1. - zalpha6 - zalpha7 79 ! 80 imin = i1 81 imax = i2 82 jmin = j1 83 jmax = j2 84 ! 85 ! Remove CORNERS 86 IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3 87 IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2 88 IF((nbondi == -1).OR.(nbondi == 2)) imin = 3 89 IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2 90 ! 91 IF( eastern_side) THEN 92 DO jn = 1, jptra 93 tra(nlci,j1:j2,k1:k2,jn) = zalpha1 * ptab(nlci,j1:j2,k1:k2,jn) + zalpha2 * ptab(nlci-1,j1:j2,k1:k2,jn) 94 DO jk = 1, jpkm1 95 DO jj = jmin,jmax 96 IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 97 tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 98 ELSE 99 tra(nlci-1,jj,jk,jn)=(zalpha4*tra(nlci,jj,jk,jn)+zalpha3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 100 IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 101 tra(nlci-1,jj,jk,jn)=( zalpha6*tra(nlci-2,jj,jk,jn)+zalpha5*tra(nlci,jj,jk,jn) & 102 + zalpha7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 103 ENDIF 74 104 ENDIF 75 ENDIF 105 END DO 106 END DO 107 ENDDO 108 ENDIF 109 ! 110 IF( northern_side ) THEN 111 DO jn = 1, jptra 112 tra(i1:i2,nlcj,k1:k2,jn) = zalpha1 * ptab(i1:i2,nlcj,k1:k2,jn) + zalpha2 * ptab(i1:i2,nlcj-1,k1:k2,jn) 113 DO jk = 1, jpkm1 114 DO ji = imin,imax 115 IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN 116 tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 117 ELSE 118 tra(ji,nlcj-1,jk,jn)=(zalpha4*tra(ji,nlcj,jk,jn)+zalpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk) 119 IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN 120 tra(ji,nlcj-1,jk,jn)=( zalpha6*tra(ji,nlcj-2,jk,jn)+zalpha5*tra(ji,nlcj,jk,jn) & 121 + zalpha7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 122 ENDIF 123 ENDIF 124 END DO 125 END DO 126 ENDDO 127 ENDIF 128 ! 129 IF( western_side) THEN 130 DO jn = 1, jptra 131 tra(1,j1:j2,k1:k2,jn) = zalpha1 * ptab(1,j1:j2,k1:k2,jn) + zalpha2 * ptab(2,j1:j2,k1:k2,jn) 132 DO jk = 1, jpkm1 133 DO jj = jmin,jmax 134 IF( umask(2,jj,jk) == 0.e0 ) THEN 135 tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk) 136 ELSE 137 tra(2,jj,jk,jn)=(zalpha4*tra(1,jj,jk,jn)+zalpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk) 138 IF( un(2,jj,jk) < 0.e0 ) THEN 139 tra(2,jj,jk,jn)=(zalpha6*tra(3,jj,jk,jn)+zalpha5*tra(1,jj,jk,jn)+zalpha7*tra(4,jj,jk,jn))*tmask(2,jj,jk) 140 ENDIF 141 ENDIF 142 END DO 76 143 END DO 77 144 END DO 78 ENDDO 79 ENDIF 80 81 IF( nbondj == 1 .OR. nbondj == 2 ) THEN 82 83 DO jn = 1, jptra 84 tra(:,nlcj,:,jn) = alpha1 * ztra(:,nlcj,:,jn) + alpha2 * ztra(:,nlcj-1,:,jn) 85 DO jk = 1, jpkm1 86 DO ji = 1, jpi 87 IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN 88 tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 89 ELSE 90 tra(ji,nlcj-1,jk,jn)=(alpha4*tra(ji,nlcj,jk,jn)+alpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk) 91 IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN 92 tra(ji,nlcj-1,jk,jn)=( alpha6*tra(ji,nlcj-2,jk,jn)+alpha5*tra(ji,nlcj,jk,jn) & 93 & + alpha7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 145 ENDIF 146 ! 147 IF( southern_side ) THEN 148 DO jn = 1, jptra 149 tra(i1:i2,1,k1:k2,jn) = zalpha1 * ptab(i1:i2,1,k1:k2,jn) + zalpha2 * ptab(i1:i2,2,k1:k2,jn) 150 DO jk=1,jpk 151 DO ji=imin,imax 152 IF( vmask(ji,2,jk) == 0.e0 ) THEN 153 tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk) 154 ELSE 155 tra(ji,2,jk,jn)=(zalpha4*tra(ji,1,jk,jn)+zalpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk) 156 IF( vn(ji,2,jk) < 0.e0 ) THEN 157 tra(ji,2,jk,jn)=(zalpha6*tra(ji,3,jk,jn)+zalpha5*tra(ji,1,jk,jn)+zalpha7*tra(ji,4,jk,jn))*tmask(ji,2,jk) 158 ENDIF 94 159 ENDIF 95 END IF160 END DO 96 161 END DO 97 END DO 98 ENDDO 99 ENDIF 100 IF( nbondi == -1 .OR. nbondi == 2 ) THEN 101 DO jn = 1, jptra 102 tra(1,:,:,jn) = alpha1 * ztra(1,:,:,jn) + alpha2 * ztra(2,:,:,jn) 103 DO jk = 1, jpkm1 104 DO jj = 1, jpj 105 IF( umask(2,jj,jk) == 0.e0 ) THEN 106 tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk) 107 ELSE 108 tra(2,jj,jk,jn)=(alpha4*tra(1,jj,jk,jn)+alpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk) 109 IF( un(2,jj,jk) < 0.e0 ) THEN 110 tra(2,jj,jk,jn)=(alpha6*tra(3,jj,jk,jn)+alpha5*tra(1,jj,jk,jn)+alpha7*tra(4,jj,jk,jn))*tmask(2,jj,jk) 111 ENDIF 112 ENDIF 113 END DO 114 END DO 115 END DO 116 ENDIF 117 118 IF( nbondj == -1 .OR. nbondj == 2 ) THEN 119 DO jn = 1, jptra 120 tra(:,1,:,jn) = alpha1 * ztra(:,1,:,jn) + alpha2 * ztra(:,2,:,jn) 121 DO jk=1,jpk 122 DO ji=1,jpi 123 IF( vmask(ji,2,jk) == 0.e0 ) THEN 124 tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk) 125 ELSE 126 tra(ji,2,jk,jn)=(alpha4*tra(ji,1,jk,jn)+alpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk) 127 IF( vn(ji,2,jk) < 0.e0 ) THEN 128 tra(ji,2,jk,jn)=(alpha6*tra(ji,3,jk,jn)+alpha5*tra(ji,1,jk,jn)+alpha7*tra(ji,4,jk,jn))*tmask(ji,2,jk) 129 ENDIF 130 ENDIF 131 END DO 132 END DO 133 ENDDO 162 ENDDO 163 ENDIF 164 ! 165 ! Treatment of corners 166 ! 167 ! East south 168 IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN 169 tra(nlci-1,2,:,:) = ptab(nlci-1,2,:,:) 170 ENDIF 171 ! East north 172 IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN 173 tra(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:) 174 ENDIF 175 ! West south 176 IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN 177 tra(2,2,:,:) = ptab(2,2,:,:) 178 ENDIF 179 ! West north 180 IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN 181 tra(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:) 182 ENDIF 183 ! 134 184 ENDIF 135 185 ! 136 CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztra ) 137 ! 138 139 END SUBROUTINE Agrif_trc 186 END SUBROUTINE interptrn 140 187 141 188 #else -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90
r3680 r6204 1 1 #define SPONGE_TOP 2 2 3 M oduleagrif_top_sponge3 MODULE agrif_top_sponge 4 4 #if defined key_agrif && defined key_top 5 5 USE par_oce 6 USE par_trc 6 7 USE oce 7 8 USE dom_oce … … 16 17 PRIVATE 17 18 18 PUBLIC Agrif_Sponge_ Trc, interptrn19 PUBLIC Agrif_Sponge_trc, interptrn_sponge 19 20 20 !! * Substitutions21 !! * Substitutions 21 22 # include "domzgr_substitute.h90" 22 23 !!---------------------------------------------------------------------- 23 !! NEMO/NST 3. 3, NEMO Consortium (2010)24 !! NEMO/NST 3.6 , NEMO Consortium (2010) 24 25 !! $Id$ 25 26 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 26 27 !!---------------------------------------------------------------------- 27 28 28 29 CONTAINS 29 30 30 SUBROUTINE Agrif_Sponge_ Trc31 SUBROUTINE Agrif_Sponge_trc 31 32 !!--------------------------------------------- 32 33 !! *** ROUTINE Agrif_Sponge_Trc *** 33 34 !!--------------------------------------------- 34 35 !! 35 INTEGER :: ji,jj,jk,jn36 36 REAL(wp) :: timecoeff 37 REAL(wp) :: ztra, zabe1, zabe2, zbtr38 REAL(wp), POINTER, DIMENSION(:,:) :: ztru, ztrv39 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztabr40 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: trbdiff41 37 42 38 #if defined SPONGE_TOP 43 CALL wrk_alloc( jpi, jpj, ztru, ztrv )44 CALL wrk_alloc( jpi, jpj, jpk, jptra, ztabr, trbdiff )45 46 39 timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 47 40 CALL Agrif_sponge 48 41 Agrif_SpecialValue=0. 49 42 Agrif_UseSpecialValue = .TRUE. 50 ztabr = 0.e051 CALL Agrif_Bc_Variable( ztabr, tra_id,calledweight=timecoeff,procname=interptrn)43 tabspongedone_trn = .FALSE. 44 CALL Agrif_Bc_Variable(trn_sponge_id,calledweight=timecoeff,procname=interptrn_sponge) 52 45 Agrif_UseSpecialValue = .FALSE. 53 54 trbdiff(:,:,:,:) = trb(:,:,:,:) - ztabr(:,:,:,:)55 56 CALL Agrif_sponge57 58 DO jn = 1, jptra59 DO jk = 1, jpkm160 !61 DO jj = 1, jpjm162 DO ji = 1, jpim163 zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk)64 zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk)65 ztru(ji,jj) = zabe1 * ( trbdiff(ji+1,jj ,jk,jn) - trbdiff(ji,jj,jk,jn) )66 ztrv(ji,jj) = zabe2 * ( trbdiff(ji ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) )67 ENDDO68 ENDDO69 70 DO jj = 2,jpjm171 DO ji = 2,jpim172 zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk)73 ! horizontal diffusive trends74 ztra = zbtr * ( ztru(ji,jj) - ztru(ji-1,jj) + ztrv(ji,jj) - ztrv(ji,jj-1) )75 ! add it to the general tracer trends76 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra77 END DO78 END DO79 !80 ENDDO81 ENDDO82 83 CALL wrk_dealloc( jpi, jpj, ztru, ztrv )84 CALL wrk_dealloc( jpi, jpj, jpk, jptra, trbdiff, ztabr )85 46 86 47 #endif … … 88 49 END SUBROUTINE Agrif_Sponge_Trc 89 50 90 SUBROUTINE interptrn (tabres,i1,i2,j1,j2,k1,k2,n1,n2)51 SUBROUTINE interptrn_sponge(tabres,i1,i2,j1,j2,k1,k2,n1,n2,before) 91 52 !!--------------------------------------------- 92 !! *** ROUTINE interpt n***53 !! *** ROUTINE interptrn_sponge *** 93 54 !!--------------------------------------------- 94 55 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 95 56 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 57 LOGICAL, INTENT(in) :: before 58 59 60 INTEGER :: ji, jj, jk, jn ! dummy loop indices 61 62 REAL(wp) :: ztra, zabe1, zabe2, zbtr 63 REAL(wp), DIMENSION(i1:i2,j1:j2) :: ztu, ztv 64 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::trbdiff 96 65 ! 97 tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2) 66 IF (before) THEN 67 tabres(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2) 68 ELSE 98 69 99 END SUBROUTINE interptrn 70 trbdiff(:,:,:,:) = trb(i1:i2,j1:j2,:,:) - tabres(:,:,:,:) 71 DO jn = 1, jptra 72 DO jk = 1, jpkm1 73 74 DO jj = j1,j2-1 75 DO ji = i1,i2-1 76 zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk) 77 zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk) 78 ztu(ji,jj) = zabe1 * ( trbdiff(ji+1,jj ,jk,jn) - trbdiff(ji,jj,jk,jn) ) 79 ztv(ji,jj) = zabe2 * ( trbdiff(ji ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) ) 80 ENDDO 81 ENDDO 82 83 DO jj = j1+1,j2-1 84 DO ji = i1+1,i2-1 85 86 IF (.NOT. tabspongedone_trn(ji,jj)) THEN 87 zbtr = r1_e12t(ji,jj) / fse3t(ji,jj,jk) 88 ! horizontal diffusive trends 89 ztra = zbtr * ( ztu(ji,jj) - ztu(ji-1,jj ) + ztv(ji,jj) - ztv(ji ,jj-1) ) 90 ! add it to the general tracer trends 91 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 92 ENDIF 93 94 ENDDO 95 ENDDO 96 97 ENDDO 98 ENDDO 99 100 tabspongedone_trn(i1+1:i2-1,j1+1:j2-1) = .TRUE. 101 ENDIF 102 ! 103 END SUBROUTINE interptrn_sponge 100 104 101 105 #else -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90
r4491 r6204 1 1 #define TWO_WAY 2 #undef DECAL_FEEDBACK 2 3 3 4 MODULE agrif_top_update … … 8 9 USE dom_oce 9 10 USE agrif_oce 11 USE par_trc 10 12 USE trc 11 13 USE wrk_nemo … … 24 26 !!---------------------------------------------------------------------- 25 27 26 28 CONTAINS 27 29 28 30 SUBROUTINE Agrif_Update_Trc( kt ) … … 30 32 !! *** ROUTINE Agrif_Update_Trc *** 31 33 !!--------------------------------------------- 32 !!33 34 INTEGER, INTENT(in) :: kt 34 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztra 35 36 37 IF ((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN 38 39 #if defined TWO_WAY 40 CALL wrk_alloc( jpi, jpj, jpk, jptra, ztra ) 41 35 !!--------------------------------------------- 36 ! 37 IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN 38 #if defined TWO_WAY 42 39 Agrif_UseSpecialValueInUpdate = .TRUE. 43 40 Agrif_SpecialValueFineGrid = 0. 44 45 IF (MOD(nbcline_trc,nbclineupdate) == 0) THEN 46 CALL Agrif_Update_Variable(ztra,trn_id, procname=updateTRC) 41 ! 42 IF (MOD(nbcline_trc,nbclineupdate) == 0) THEN 43 # if ! defined DECAL_FEEDBACK 44 CALL Agrif_Update_Variable(trn_id, procname=updateTRC) 45 # else 46 CALL Agrif_Update_Variable(trn_id, locupdate=(/1,0/),procname=updateTRC) 47 # endif 47 48 ELSE 48 CALL Agrif_Update_Variable(ztra,trn_id,locupdate=(/0,2/), procname=updateTRC) 49 # if ! defined DECAL_FEEDBACK 50 CALL Agrif_Update_Variable(trn_id,locupdate=(/0,2/), procname=updateTRC) 51 # else 52 CALL Agrif_Update_Variable(trn_id,locupdate=(/1,2/), procname=updateTRC) 53 # endif 49 54 ENDIF 50 55 ! 51 56 Agrif_UseSpecialValueInUpdate = .FALSE. 52 57 nbcline_trc = nbcline_trc + 1 53 54 CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztra )55 58 #endif 56 59 ! 57 60 END SUBROUTINE Agrif_Update_Trc 58 61 59 SUBROUTINE updateTRC( tabres,i1,i2,j1,j2,k1,k2,n1,n2,before)62 SUBROUTINE updateTRC( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before ) 60 63 !!--------------------------------------------- 61 !! *** ROUTINE UpdateTrc***64 !! *** ROUTINE updateT *** 62 65 !!--------------------------------------------- 66 # include "domzgr_substitute.h90" 63 67 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 64 REAL , DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres68 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab 65 69 LOGICAL, INTENT(in) :: before 66 70 !! 67 71 INTEGER :: ji,jj,jk,jn 68 69 IF( before ) THEN 70 DO jn = n1, n2 71 DO jk = k1, k2 72 DO jj = j1, j2 73 DO ji = i1, i2 74 tabres(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 75 ENDDO 76 ENDDO 77 ENDDO 78 ENDDO 79 ELSE 80 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 72 !!--------------------------------------------- 73 ! 74 IF (before) THEN 75 DO jn = n1,n2 76 DO jk=k1,k2 77 DO jj=j1,j2 78 DO ji=i1,i2 79 ptab(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 80 END DO 81 END DO 82 END DO 83 END DO 84 ELSE 85 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 81 86 ! Add asselin part 82 DO jn = n1, n2 83 DO jk = k1, k2 84 DO jj = j1, j2 85 DO ji = i1, i2 86 IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN 87 trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn) & 88 & + atfp * ( tabres(ji,jj,jk,jn) & 89 - trn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 90 ENDIF 91 ENDDO 92 ENDDO 93 ENDDO 94 ENDDO 95 ENDIF 96 97 DO jn = n1, n2 98 DO jk = k1, k2 99 DO jj = j1, j2 100 DO ji = i1, i2 101 IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN 102 trn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) * tmask(ji,jj,jk) 87 DO jn = n1,n2 88 DO jk=k1,k2 89 DO jj=j1,j2 90 DO ji=i1,i2 91 IF( ptab(ji,jj,jk,jn) .NE. 0. ) THEN 92 trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn) & 93 & + atfp * ( ptab(ji,jj,jk,jn) & 94 & - trn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 103 95 ENDIF 104 96 ENDDO … … 107 99 ENDDO 108 100 ENDIF 109 101 DO jn = n1,n2 102 DO jk=k1,k2 103 DO jj=j1,j2 104 DO ji=i1,i2 105 IF( ptab(ji,jj,jk,jn) .NE. 0. ) THEN 106 trn(ji,jj,jk,jn) = ptab(ji,jj,jk,jn) * tmask(ji,jj,jk) 107 END IF 108 END DO 109 END DO 110 END DO 111 END DO 112 ENDIF 113 ! 110 114 END SUBROUTINE updateTRC 111 115 … … 119 123 END SUBROUTINE agrif_top_update_empty 120 124 #endif 121 END M oduleagrif_top_update125 END MODULE agrif_top_update -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
r5574 r6204 30 30 jpi = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci 31 31 jpj = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj 32 jpk = jpkdta 32 ! JC: change to allow for different vertical levels 33 ! jpk is already set 34 ! keep it jpk possibly different from jpkdta which 35 ! hold parent grid vertical levels number (set earlier) 36 ! jpk = jpkdta 33 37 jpim1 = jpi-1 34 38 jpjm1 = jpj-1 … … 63 67 ! 0. Initializations 64 68 !------------------- 65 IF( cp_cfg == 'orca' ) then69 IF( cp_cfg == 'orca' ) THEN 66 70 IF ( jp_cfg == 2 .OR. jp_cfg == 025 .OR. jp_cfg == 05 & 67 & .OR. jp_cfg == 4 ) THEN71 & .OR. jp_cfg == 4 ) THEN 68 72 jp_cfg = -1 ! set special value for jp_cfg on fine grids 69 73 cp_cfg = "default" … … 119 123 SUBROUTINE agrif_declare_var_dom 120 124 !!---------------------------------------------------------------------- 121 !! *** ROUTINE agrif_declar E_var ***125 !! *** ROUTINE agrif_declare_var *** 122 126 !! 123 127 !! ** Purpose :: Declaration of variables to be interpolated 124 128 !!---------------------------------------------------------------------- 125 129 USE agrif_util 126 USE par_oce ! ONLY : jpts130 USE par_oce 127 131 USE oce 128 132 IMPLICIT NONE … … 131 135 ! 1. Declaration of the type of variable which have to be interpolated 132 136 !--------------------------------------------------------------------- 133 CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id) 134 CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id) 135 137 CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id) 138 CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id) 136 139 137 140 ! 2. Type of interpolation 138 141 !------------------------- 139 C allAgrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm)140 C allAgrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear)142 CALL Agrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 143 CALL Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 141 144 142 145 ! 3. Location of interpolation 143 146 !----------------------------- 144 C allAgrif_Set_bc(e1u_id,(/0,0/))145 C allAgrif_Set_bc(e2v_id,(/0,0/))147 CALL Agrif_Set_bc(e1u_id,(/0,0/)) 148 CALL Agrif_Set_bc(e2v_id,(/0,0/)) 146 149 147 150 ! 5. Update type 148 151 !--------------- 149 Call Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average) 150 Call Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 151 152 CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average) 153 CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 154 155 ! High order updates 156 ! CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Full_Weighting) 157 ! CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average) 158 ! 152 159 END SUBROUTINE agrif_declare_var_dom 153 160 … … 166 173 USE nemogcm 167 174 USE sol_oce 175 USE lib_mpp 168 176 USE in_out_manager 169 177 USE agrif_opa_update … … 173 181 IMPLICIT NONE 174 182 ! 175 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtstemp176 REAL(wp), DIMENSION(:,:,: ), ALLOCATABLE :: tabuvtemp177 REAL(wp), DIMENSION(:,: ), ALLOCATABLE :: tab2d178 183 LOGICAL :: check_namelist 179 !!---------------------------------------------------------------------- 180 181 ALLOCATE( tabtstemp(jpi, jpj, jpk, jpts) ) 182 ALLOCATE( tabuvtemp(jpi, jpj, jpk) ) 183 ALLOCATE( tab2d(jpi, jpj) ) 184 184 CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3 185 !!---------------------------------------------------------------------- 185 186 186 187 ! 1. Declaration of the type of variable which have to be interpolated … … 192 193 Agrif_SpecialValue=0. 193 194 Agrif_UseSpecialValue = .TRUE. 194 Call Agrif_Bc_variable(tabtstemp,tsn_id,calledweight=1.,procname=interptsn) 195 Call Agrif_Bc_variable(tabtstemp,tsa_id,calledweight=1.,procname=interptsn) 196 197 Call Agrif_Bc_variable(tabuvtemp,un_id,calledweight=1.,procname=interpu) 198 Call Agrif_Bc_variable(tabuvtemp,vn_id,calledweight=1.,procname=interpv) 199 Call Agrif_Bc_variable(tabuvtemp,ua_id,calledweight=1.,procname=interpun) 200 Call Agrif_Bc_variable(tabuvtemp,va_id,calledweight=1.,procname=interpvn) 201 202 Call Agrif_Bc_variable(tab2d,unb_id,calledweight=1.,procname=interpunb) 203 Call Agrif_Bc_variable(tab2d,vnb_id,calledweight=1.,procname=interpvnb) 204 Call Agrif_Bc_variable(tab2d,sshn_id,calledweight=1.,procname=interpsshn) 205 Agrif_UseSpecialValue = .FALSE. 195 CALL Agrif_Bc_variable(tsn_id,calledweight=1.,procname=interptsn) 196 CALL Agrif_Sponge 197 tabspongedone_tsn = .FALSE. 198 CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge) 199 ! reset tsa to zero 200 tsa(:,:,:,:) = 0. 201 202 Agrif_UseSpecialValue = ln_spc_dyn 203 CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun) 204 CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn) 205 tabspongedone_u = .FALSE. 206 tabspongedone_v = .FALSE. 207 CALL Agrif_Bc_variable(un_sponge_id,calledweight=1.,procname=interpun_sponge) 208 tabspongedone_u = .FALSE. 209 tabspongedone_v = .FALSE. 210 CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge) 211 212 #if defined key_dynspg_ts 213 Agrif_UseSpecialValue = .TRUE. 214 CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn ) 215 216 Agrif_UseSpecialValue = ln_spc_dyn 217 CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb) 218 CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb) 219 CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) 220 CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) 221 ubdy_w(:) = 0.e0 ; vbdy_w(:) = 0.e0 ; hbdy_w(:) =0.e0 222 ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0 ; hbdy_e(:) =0.e0 223 ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0 ; hbdy_n(:) =0.e0 224 ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0 ; hbdy_s(:) =0.e0 225 #endif 226 227 Agrif_UseSpecialValue = .FALSE. 228 ! reset velocities to zero 229 ua(:,:,:) = 0. 230 va(:,:,:) = 0. 206 231 207 232 ! 3. Some controls 208 233 !----------------- 209 check_namelist = . true.210 211 IF( check_namelist ) THEN 234 check_namelist = .TRUE. 235 236 IF( check_namelist ) THEN 212 237 213 238 ! Check time steps 214 IF( NINT(Agrif_Rhot()) * nint(rdt) /= Agrif_Parent(rdt) ) THEN 215 WRITE(*,*) 'incompatible time step between grids' 216 WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt) 217 WRITE(*,*) 'child grid value : ',nint(rdt) 218 WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot() 219 STOP 239 IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 240 WRITE(cl_check1,*) NINT(Agrif_Parent(rdt)) 241 WRITE(cl_check2,*) NINT(rdt) 242 WRITE(cl_check3,*) NINT(Agrif_Parent(rdt)/Agrif_Rhot()) 243 CALL ctl_warn( 'incompatible time step between grids', & 244 & 'parent grid value : '//cl_check1 , & 245 & 'child grid value : '//cl_check2 , & 246 & 'value on child grid will be changed to : '//cl_check3 ) 247 rdt=Agrif_Parent(rdt)/Agrif_Rhot() 220 248 ENDIF 221 249 222 250 ! Check run length 223 251 IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 224 Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN 225 WRITE(*,*) 'incompatible run length between grids' 226 WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- & 227 Agrif_Parent(nit000)+1),' time step' 228 WRITE(*,*) 'child grid value : ', & 229 (nitend-nit000+1),' time step' 230 WRITE(*,*) 'value on child grid should be : ', & 231 Agrif_IRhot() * (Agrif_Parent(nitend)- & 232 Agrif_Parent(nit000)+1) 233 STOP 252 Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN 253 WRITE(cl_check1,*) (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 254 WRITE(cl_check2,*) Agrif_Parent(nitend) *Agrif_IRhot() 255 CALL ctl_warn( 'incompatible run length between grids' , & 256 & ' nit000 on fine grid will be change to : '//cl_check1, & 257 & ' nitend on fine grid will be change to : '//cl_check2 ) 258 nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 259 nitend = Agrif_Parent(nitend) *Agrif_IRhot() 234 260 ENDIF 235 261 … … 237 263 IF( ln_zps ) THEN 238 264 ! check parameters for partial steps 239 IF( Agrif_Parent(e3zps_min) . ne. e3zps_min ) THEN265 IF( Agrif_Parent(e3zps_min) .NE. e3zps_min ) THEN 240 266 WRITE(*,*) 'incompatible e3zps_min between grids' 241 267 WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min) … … 252 278 ENDIF 253 279 ENDIF 280 ! check if masks and bathymetries match 281 IF(ln_chk_bathy) THEN 282 ! 283 IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level() 284 ! 285 kindic_agr = 0 286 ! check if umask agree with parent along western and eastern boundaries: 287 CALL Agrif_Bc_variable(umsk_id,calledweight=1.,procname=interpumsk) 288 ! check if vmask agree with parent along northern and southern boundaries: 289 CALL Agrif_Bc_variable(vmsk_id,calledweight=1.,procname=interpvmsk) 290 ! check if tmask and vertical scale factors agree with parent over first two coarse grid points: 291 CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t) 292 ! 293 IF (lk_mpp) CALL mpp_sum( kindic_agr ) 294 IF( kindic_agr /= 0 ) THEN 295 CALL ctl_stop('Child Bathymetry is not correct near boundaries.') 296 ELSE 297 IF(lwp) WRITE(numout,*) 'Child Bathymetry is ok near boundaries.' 298 END IF 299 ENDIF 300 ! 254 301 ENDIF 255 256 CALL Agrif_Update_tra(0) 257 CALL Agrif_Update_dyn(0) 258 302 ! 303 ! Do update at initialisation because not done before writing restarts 304 ! This would indeed change boundary conditions values at initial time 305 ! hence produce restartability issues. 306 ! Note that update below is recursive (with lk_agrif_doupd=T): 307 ! 308 ! JC: I am not sure if Agrif_MaxLevel() is the "relative" 309 ! or the absolute maximum nesting level...TBC 310 IF ( Agrif_Level().EQ.Agrif_MaxLevel() ) THEN 311 ! NB: Do tracers first, dynamics after because nbcline incremented in dynamics 312 CALL Agrif_Update_tra() 313 CALL Agrif_Update_dyn() 314 ENDIF 315 ! 316 # if defined key_zdftke 317 ! CALL Agrif_Update_tke(0) 318 # endif 319 ! 320 Agrif_UseSpecialValueInUpdate = .FALSE. 259 321 nbcline = 0 260 ! 261 DEALLOCATE(tabtstemp) 262 DEALLOCATE(tabuvtemp) 263 DEALLOCATE(tab2d) 322 lk_agrif_doupd = .FALSE. 264 323 ! 265 324 END SUBROUTINE Agrif_InitValues_cont … … 275 334 USE par_oce ! ONLY : jpts 276 335 USE oce 336 USE agrif_oce 277 337 IMPLICIT NONE 278 338 !!---------------------------------------------------------------------- … … 280 340 ! 1. Declaration of the type of variable which have to be interpolated 281 341 !--------------------------------------------------------------------- 282 CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_id) 283 CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsa_id) 284 CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsb_id) 285 286 CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),un_id) 287 CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),vn_id) 288 CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),ua_id) 289 CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),va_id) 290 291 CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),unb_id) 292 CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vnb_id) 293 CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id) 294 CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gcb_id) 295 CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_id) 296 CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_id) 342 CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id) 343 CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id) 344 345 CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_interp_id) 346 CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_interp_id) 347 CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_update_id) 348 CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_update_id) 349 CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_sponge_id) 350 CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_sponge_id) 351 352 CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id) 353 CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id) 354 CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id) 355 356 CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,3/),scales_t_id) 357 358 CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id) 359 CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id) 360 CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id) 361 CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id) 362 CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id) 363 CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id) 364 365 CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id) 366 367 # if defined key_zdftke 368 CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id) 369 CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id) 370 CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avm_id) 371 # endif 297 372 298 373 ! 2. Type of interpolation 299 374 !------------------------- 300 375 CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear) 301 CALL Agrif_Set_bcinterp(tsa_id,interp=AGRIF_linear) 302 303 Call Agrif_Set_bcinterp(un_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 304 Call Agrif_Set_bcinterp(vn_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 305 306 Call Agrif_Set_bcinterp(ua_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 307 Call Agrif_Set_bcinterp(va_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 376 377 CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 378 CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 379 380 CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear) 308 381 309 382 CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear) 310 Call Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 311 Call Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 312 Call Agrif_Set_bcinterp(ub2b_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 313 Call Agrif_Set_bcinterp(vb2b_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 383 CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 384 CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 385 CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 386 CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 387 388 389 CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 390 CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 391 392 CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant) 393 CALL Agrif_Set_bcinterp(umsk_id,interp=AGRIF_constant) 394 CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant) 395 396 # if defined key_zdftke 397 CALL Agrif_Set_bcinterp(avm_id ,interp=AGRIF_linear) 398 # endif 399 314 400 315 401 ! 3. Location of interpolation 316 402 !----------------------------- 317 Call Agrif_Set_bc(un_id,(/0,1/)) 318 Call Agrif_Set_bc(vn_id,(/0,1/)) 319 320 Call Agrif_Set_bc(sshn_id,(/0,1/)) 321 Call Agrif_Set_bc(unb_id,(/0,1/)) 322 Call Agrif_Set_bc(vnb_id,(/0,1/)) 323 Call Agrif_Set_bc(ub2b_id,(/0,1/)) 324 Call Agrif_Set_bc(vb2b_id,(/0,1/)) 325 326 Call Agrif_Set_bc(tsn_id,(/0,1/)) 327 Call Agrif_Set_bc(tsa_id,(/-3*Agrif_irhox(),0/)) 328 329 Call Agrif_Set_bc(ua_id,(/-2*Agrif_irhox(),0/)) 330 Call Agrif_Set_bc(va_id,(/-2*Agrif_irhox(),0/)) 403 CALL Agrif_Set_bc(tsn_id,(/0,1/)) 404 CALL Agrif_Set_bc(un_interp_id,(/0,1/)) 405 CALL Agrif_Set_bc(vn_interp_id,(/0,1/)) 406 407 ! CALL Agrif_Set_bc(tsn_sponge_id,(/-3*Agrif_irhox(),0/)) 408 ! CALL Agrif_Set_bc(un_sponge_id,(/-2*Agrif_irhox()-1,0/)) 409 ! CALL Agrif_Set_bc(vn_sponge_id,(/-2*Agrif_irhox()-1,0/)) 410 CALL Agrif_Set_bc(tsn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 411 CALL Agrif_Set_bc(un_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 412 CALL Agrif_Set_bc(vn_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 413 414 CALL Agrif_Set_bc(sshn_id,(/0,0/)) 415 CALL Agrif_Set_bc(unb_id ,(/0,0/)) 416 CALL Agrif_Set_bc(vnb_id ,(/0,0/)) 417 CALL Agrif_Set_bc(ub2b_interp_id,(/0,0/)) 418 CALL Agrif_Set_bc(vb2b_interp_id,(/0,0/)) 419 420 CALL Agrif_Set_bc(e3t_id,(/-2*Agrif_irhox()-1,0/)) ! if west and rhox=3: column 2 to 9 421 CALL Agrif_Set_bc(umsk_id,(/0,0/)) 422 CALL Agrif_Set_bc(vmsk_id,(/0,0/)) 423 424 # if defined key_zdftke 425 CALL Agrif_Set_bc(avm_id ,(/0,1/)) 426 # endif 331 427 332 428 ! 5. Update type 333 429 !--------------- 334 Call Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average) 335 Call Agrif_Set_Updatetype(tsb_id, update = AGRIF_Update_Average) 336 337 Call Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average) 338 Call Agrif_Set_Updatetype(gcb_id,update = AGRIF_Update_Average) 339 340 Call Agrif_Set_Updatetype(un_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 341 Call Agrif_Set_Updatetype(vn_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 342 343 Call Agrif_Set_Updatetype(ub2b_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 344 Call Agrif_Set_Updatetype(vb2b_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 345 430 CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average) 431 432 CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average) 433 434 CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 435 CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 436 437 CALL Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average) 438 439 CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 440 CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 441 442 # if defined key_zdftke 443 CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average) 444 CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average) 445 CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average) 446 # endif 447 448 ! High order updates 449 ! CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting) 450 ! CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 451 ! CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 452 ! 453 ! CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 454 ! CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 455 ! CALL Agrif_Set_Updatetype(sshn_id, update = Agrif_Update_Full_Weighting) 456 457 ! 346 458 END SUBROUTINE agrif_declare_var 347 459 # endif … … 364 476 IMPLICIT NONE 365 477 ! 366 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: zvel 367 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zadv 368 !!---------------------------------------------------------------------- 369 370 ALLOCATE( zvel(jpi,jpj), zadv(jpi,jpj,7)) 478 !!---------------------------------------------------------------------- 371 479 372 480 ! 1. Declaration of the type of variable which have to be interpolated … … 400 508 CALL Agrif_Update_lim2(0) 401 509 ! 402 DEALLOCATE( zvel, zadv )403 !404 510 END SUBROUTINE Agrif_InitValues_cont_lim2 405 511 … … 430 536 !------------------------- 431 537 CALL Agrif_Set_bcinterp(adv_ice_id ,interp=AGRIF_linear) 432 C allAgrif_Set_bcinterp(u_ice_id,interp1=Agrif_linear,interp2=AGRIF_ppm)433 C allAgrif_Set_bcinterp(v_ice_id,interp1=AGRIF_ppm,interp2=Agrif_linear)538 CALL Agrif_Set_bcinterp(u_ice_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 539 CALL Agrif_Set_bcinterp(v_ice_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 434 540 435 541 ! 3. Location of interpolation 436 542 !----------------------------- 437 C allAgrif_Set_bc(adv_ice_id ,(/0,1/))438 C allAgrif_Set_bc(u_ice_id,(/0,1/))439 C allAgrif_Set_bc(v_ice_id,(/0,1/))543 CALL Agrif_Set_bc(adv_ice_id ,(/0,1/)) 544 CALL Agrif_Set_bc(u_ice_id,(/0,1/)) 545 CALL Agrif_Set_bc(v_ice_id,(/0,1/)) 440 546 441 547 ! 5. Update type 442 548 !--------------- 443 C allAgrif_Set_Updatetype(adv_ice_id , update = AGRIF_Update_Average)444 C allAgrif_Set_Updatetype(u_ice_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)445 C allAgrif_Set_Updatetype(v_ice_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)446 549 CALL Agrif_Set_Updatetype(adv_ice_id , update = AGRIF_Update_Average) 550 CALL Agrif_Set_Updatetype(u_ice_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 551 CALL Agrif_Set_Updatetype(v_ice_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 552 ! 447 553 END SUBROUTINE agrif_declare_var_lim2 448 554 # endif … … 461 567 USE nemogcm 462 568 USE par_trc 569 USE lib_mpp 463 570 USE trc 464 571 USE in_out_manager 572 USE agrif_opa_sponge 465 573 USE agrif_top_update 466 574 USE agrif_top_interp … … 469 577 IMPLICIT NONE 470 578 ! 471 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtrtemp579 CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3 472 580 LOGICAL :: check_namelist 473 581 !!---------------------------------------------------------------------- 474 475 ALLOCATE( tabtrtemp(jpi,jpj,jpk,jptra) )476 582 477 583 … … 484 590 Agrif_SpecialValue=0. 485 591 Agrif_UseSpecialValue = .TRUE. 486 Call Agrif_Bc_variable(tabtrtemp,trn_id,calledweight=1.,procname=interptrn) 487 Call Agrif_Bc_variable(tabtrtemp,tra_id,calledweight=1.,procname=interptrn) 592 CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn) 488 593 Agrif_UseSpecialValue = .FALSE. 594 CALL Agrif_Sponge 595 tabspongedone_trn = .FALSE. 596 CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 597 ! reset tsa to zero 598 tra(:,:,:,:) = 0. 599 489 600 490 601 ! 3. Some controls 491 602 !----------------- 492 check_namelist = . true.603 check_namelist = .TRUE. 493 604 494 605 IF( check_namelist ) THEN 495 # if defined offline606 # if defined key_offline 496 607 ! Check time steps 497 IF( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) THEN 498 WRITE(*,*) 'incompatible time step between grids' 499 WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt) 500 WRITE(*,*) 'child grid value : ',nint(rdt) 501 WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot() 502 STOP 608 IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 609 WRITE(cl_check1,*) Agrif_Parent(rdt) 610 WRITE(cl_check2,*) rdt 611 WRITE(cl_check3,*) rdt*Agrif_Rhot() 612 CALL ctl_warn( 'incompatible time step between grids', & 613 & 'parent grid value : '//cl_check1 , & 614 & 'child grid value : '//cl_check2 , & 615 & 'value on child grid will be changed to & 616 & :'//cl_check3 ) 617 rdt=rdt*Agrif_Rhot() 503 618 ENDIF 504 619 505 620 ! Check run length 506 621 IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 507 Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN 508 WRITE(*,*) 'incompatible run length between grids' 509 WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- & 510 Agrif_Parent(nit000)+1),' time step' 511 WRITE(*,*) 'child grid value : ', & 512 (nitend-nit000+1),' time step' 513 WRITE(*,*) 'value on child grid should be : ', & 514 Agrif_IRhot() * (Agrif_Parent(nitend)- & 515 Agrif_Parent(nit000)+1) 516 STOP 622 Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN 623 WRITE(cl_check1,*) (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 624 WRITE(cl_check2,*) Agrif_Parent(nitend) *Agrif_IRhot() 625 CALL ctl_warn( 'incompatible run length between grids' , & 626 & ' nit000 on fine grid will be change to : '//cl_check1, & 627 & ' nitend on fine grid will be change to : '//cl_check2 ) 628 nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 629 nitend = Agrif_Parent(nitend) *Agrif_IRhot() 517 630 ENDIF 518 631 … … 520 633 IF( ln_zps ) THEN 521 634 ! check parameters for partial steps 522 IF( Agrif_Parent(e3zps_min) . ne. e3zps_min ) THEN635 IF( Agrif_Parent(e3zps_min) .NE. e3zps_min ) THEN 523 636 WRITE(*,*) 'incompatible e3zps_min between grids' 524 637 WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min) … … 527 640 STOP 528 641 ENDIF 529 IF( Agrif_Parent(e3zps_rat) . ne. e3zps_rat ) THEN642 IF( Agrif_Parent(e3zps_rat) .NE. e3zps_rat ) THEN 530 643 WRITE(*,*) 'incompatible e3zps_rat between grids' 531 644 WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat) … … 537 650 # endif 538 651 ! Check passive tracer cell 539 IF( nn_dttrc . ne. 1 ) THEN652 IF( nn_dttrc .NE. 1 ) THEN 540 653 WRITE(*,*) 'nn_dttrc should be equal to 1' 541 654 ENDIF 542 655 ENDIF 543 656 544 !ch CALL Agrif_Update_trc(0) 657 CALL Agrif_Update_trc(0) 658 ! 659 Agrif_UseSpecialValueInUpdate = .FALSE. 545 660 nbcline_trc = 0 546 !547 DEALLOCATE(tabtrtemp)548 661 ! 549 662 END SUBROUTINE Agrif_InitValues_cont_top … … 557 670 !!---------------------------------------------------------------------- 558 671 USE agrif_util 672 USE agrif_oce 559 673 USE dom_oce 560 674 USE trc … … 564 678 ! 1. Declaration of the type of variable which have to be interpolated 565 679 !--------------------------------------------------------------------- 566 CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id) 567 CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trb_id) 568 CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),tra_id) 680 CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_id) 681 CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_sponge_id) 569 682 570 683 ! 2. Type of interpolation 571 684 !------------------------- 572 685 CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear) 573 CALL Agrif_Set_bcinterp(tr a_id,interp=AGRIF_linear)686 CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear) 574 687 575 688 ! 3. Location of interpolation 576 689 !----------------------------- 577 Call Agrif_Set_bc(trn_id,(/0,1/)) 578 Call Agrif_Set_bc(tra_id,(/-3*Agrif_irhox(),0/)) 690 CALL Agrif_Set_bc(trn_id,(/0,1/)) 691 ! CALL Agrif_Set_bc(trn_sponge_id,(/-3*Agrif_irhox(),0/)) 692 CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 579 693 580 694 ! 5. Update type 581 695 !--------------- 582 Call Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average) 583 Call Agrif_Set_Updatetype(trb_id, update = AGRIF_Update_Average) 584 585 696 CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average) 697 698 ! Higher order update 699 ! CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting) 700 701 ! 586 702 END SUBROUTINE agrif_declare_var_top 587 703 # endif … … 591 707 !! *** ROUTINE Agrif_detect *** 592 708 !!---------------------------------------------------------------------- 593 USE Agrif_Types594 709 ! 595 710 INTEGER, DIMENSION(2) :: ksizex … … 613 728 ! 614 729 INTEGER :: ios ! Local integer output status for namelist read 615 NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn 616 !!---------------------------------------------------------------------- 617 ! 618 REWIND( numnam_ref ) ! Namelist namagrif in reference namelist : AGRIF zoom 619 READ ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901) 620 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist', lwp ) 621 622 REWIND( numnam_cfg ) ! Namelist namagrif in configuration namelist : AGRIF zoom 623 READ ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 ) 624 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist', lwp ) 625 IF(lwm) WRITE ( numond, namagrif ) 730 INTEGER :: iminspon 731 NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn, ln_chk_bathy 732 !!-------------------------------------------------------------------------------------- 733 ! 734 REWIND( numnam_ref ) ! Namelist namagrif in reference namelist : AGRIF zoom 735 READ ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901) 736 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist', lwp ) 737 738 REWIND( numnam_cfg ) ! Namelist namagrif in configuration namelist : AGRIF zoom 739 READ ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 ) 740 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist', lwp ) 741 IF(lwm) WRITE ( numond, namagrif ) 626 742 ! 627 743 IF(lwp) THEN ! control print … … 634 750 WRITE(numout,*) ' sponge coefficient for dynamics rn_sponge_tra = ', rn_sponge_dyn, ' s' 635 751 WRITE(numout,*) ' use special values for dynamics ln_spc_dyn = ', ln_spc_dyn 752 WRITE(numout,*) ' check bathymetry ln_chk_bathy = ', ln_chk_bathy 636 753 WRITE(numout,*) 637 754 ENDIF … … 642 759 visc_dyn = rn_sponge_dyn 643 760 ! 644 IF( agrif_oce_alloc() > 0 ) CALL ctl_warn('agrif sol_oce_alloc: allocation of arrays failed') 761 ! Check sponge length: 762 iminspon = MIN(FLOOR(REAL(jpiglo-4)/REAL(2*Agrif_irhox())), FLOOR(REAL(jpjglo-4)/REAL(2*Agrif_irhox())) ) 763 IF (lk_mpp) iminspon = MIN(iminspon,FLOOR(REAL(jpi-2)/REAL(Agrif_irhox())), FLOOR(REAL(jpj-2)/REAL(Agrif_irhox())) ) 764 IF (nn_sponge_len > iminspon) CALL ctl_stop('agrif sponge length is too large') 765 ! 766 IF( agrif_oce_alloc() > 0 ) CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed') 645 767 # if defined key_lim2 646 768 IF( agrif_ice_alloc() > 0 ) CALL ctl_stop('agrif agrif_ice_alloc: allocation of arrays failed') … … 663 785 SELECT CASE( i ) 664 786 CASE(1) ; indglob = indloc + nimppt(nprocloc+1) - 1 665 CASE(2) ; indglob = indloc + njmppt(nprocloc+1) - 1 666 CASE (3) ; indglob = indloc667 CASE(4) ;indglob = indloc787 CASE(2) ; indglob = indloc + njmppt(nprocloc+1) - 1 788 CASE DEFAULT 789 indglob = indloc 668 790 END SELECT 669 791 ! 670 792 END SUBROUTINE Agrif_InvLoc 793 794 SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax ) 795 !!---------------------------------------------------------------------- 796 !! *** ROUTINE Agrif_get_proc_info *** 797 !!---------------------------------------------------------------------- 798 USE par_oce 799 IMPLICIT NONE 800 ! 801 INTEGER, INTENT(out) :: imin, imax 802 INTEGER, INTENT(out) :: jmin, jmax 803 !!---------------------------------------------------------------------- 804 ! 805 imin = nimppt(Agrif_Procrank+1) ! ????? 806 jmin = njmppt(Agrif_Procrank+1) ! ????? 807 imax = imin + jpi - 1 808 jmax = jmin + jpj - 1 809 ! 810 END SUBROUTINE Agrif_get_proc_info 811 812 SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost) 813 !!---------------------------------------------------------------------- 814 !! *** ROUTINE Agrif_estimate_parallel_cost *** 815 !!---------------------------------------------------------------------- 816 USE par_oce 817 IMPLICIT NONE 818 ! 819 INTEGER, INTENT(in) :: imin, imax 820 INTEGER, INTENT(in) :: jmin, jmax 821 INTEGER, INTENT(in) :: nbprocs 822 REAL(wp), INTENT(out) :: grid_cost 823 !!---------------------------------------------------------------------- 824 ! 825 grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp) 826 ! 827 END SUBROUTINE Agrif_estimate_parallel_cost 671 828 672 829 # endif -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90
r5887 r6204 107 107 REAL(wp) :: zwgt, zwgt1 ! local scalar 108 108 REAL(wp) :: ztmelts, zdh 109 #if defined key_lim2 && ! defined key_lim2_vp && defined key_agrif 110 USE ice_2, vt_s => hsnm 111 USE ice_2, vt_i => hicm 112 #endif 109 113 110 114 !!------------------------------------------------------------------------------ -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90
r4990 r6204 76 76 INTEGER :: ib_bdy, ii, ij, ik, igrd, ib, ir, iseg ! dummy loop indices 77 77 INTEGER :: icount, icountr, ibr_max, ilen1, ibm1 ! local integers 78 INTEGER :: iw , ie, is, in, inum, id_dummy ! - -78 INTEGER :: iwe, ies, iso, ino, inum, id_dummy ! - - 79 79 INTEGER :: igrd_start, igrd_end, jpbdta ! - - 80 80 INTEGER :: jpbdtau, jpbdtas ! - - … … 777 777 ! is = mjg(1) + 1 ! if monotasking and no zoom, is=2 778 778 ! in = mjg(1) + nlcj-1 - 1 ! if monotasking and no zoom, in=jpjm1 779 iw = mig(1) - jpizoom + 2 ! if monotasking and no zoom, iw=2780 ie = mig(1) + nlci - jpizoom - 1 ! if monotasking and no zoom, ie=jpim1781 is = mjg(1) - jpjzoom + 2 ! if monotasking and no zoom, is=2782 in = mjg(1) + nlcj - jpjzoom - 1 ! if monotasking and no zoom, in=jpjm1779 iwe = mig(1) - jpizoom + 2 ! if monotasking and no zoom, iw=2 780 ies = mig(1) + nlci - jpizoom - 1 ! if monotasking and no zoom, ie=jpim1 781 iso = mjg(1) - jpjzoom + 2 ! if monotasking and no zoom, is=2 782 ino = mjg(1) + nlcj - jpjzoom - 1 ! if monotasking and no zoom, in=jpjm1 783 783 784 784 ALLOCATE( nbondi_bdy(nb_bdy)) … … 853 853 ENDIF 854 854 ! check if point is in local domain 855 IF( nbidta(ib,igrd,ib_bdy) >= iw .AND. nbidta(ib,igrd,ib_bdy) <= ie.AND. &856 & nbjdta(ib,igrd,ib_bdy) >= is .AND. nbjdta(ib,igrd,ib_bdy) <= in) THEN855 IF( nbidta(ib,igrd,ib_bdy) >= iwe .AND. nbidta(ib,igrd,ib_bdy) <= ies .AND. & 856 & nbjdta(ib,igrd,ib_bdy) >= iso .AND. nbjdta(ib,igrd,ib_bdy) <= ino ) THEN 857 857 ! 858 858 icount = icount + 1 … … 890 890 com_south_b = 0 891 891 com_north_b = 0 892 892 893 DO igrd = 1, jpbgrd 893 894 icount = 0 … … 896 897 DO ib = 1, nblendta(igrd,ib_bdy) 897 898 ! check if point is in local domain and equals ir 898 IF( nbidta(ib,igrd,ib_bdy) >= iw .AND. nbidta(ib,igrd,ib_bdy) <= ie.AND. &899 & nbjdta(ib,igrd,ib_bdy) >= is .AND. nbjdta(ib,igrd,ib_bdy) <= in.AND. &899 IF( nbidta(ib,igrd,ib_bdy) >= iwe .AND. nbidta(ib,igrd,ib_bdy) <= ies .AND. & 900 & nbjdta(ib,igrd,ib_bdy) >= iso .AND. nbjdta(ib,igrd,ib_bdy) <= ino .AND. & 900 901 & nbrdta(ib,igrd,ib_bdy) == ir ) THEN 901 902 ! … … 1594 1595 ELSE 1595 1596 ! This is a corner 1596 WRITE(numout,*) 'Found a South-West corner at (i,j): ', jpiwob(ib), jpjwdt(ib)1597 IF(lwp) WRITE(numout,*) 'Found a South-West corner at (i,j): ', jpiwob(ib), jpjwdt(ib) 1597 1598 CALL bdy_ctl_corn(npckgw(ib), icornw(ib,1)) 1598 1599 itest=itest+1 … … 1608 1609 ELSE 1609 1610 ! This is a corner 1610 WRITE(numout,*) 'Found a North-West corner at (i,j): ', jpiwob(ib), jpjwft(ib)1611 IF(lwp) WRITE(numout,*) 'Found a North-West corner at (i,j): ', jpiwob(ib), jpjwft(ib) 1611 1612 CALL bdy_ctl_corn(npckgw(ib), icornw(ib,2)) 1612 1613 itest=itest+1 … … 1638 1639 ELSE 1639 1640 ! This is a corner 1640 WRITE(numout,*) 'Found a South-East corner at (i,j): ', jpieob(ib)+1, jpjedt(ib)1641 IF(lwp) WRITE(numout,*) 'Found a South-East corner at (i,j): ', jpieob(ib)+1, jpjedt(ib) 1641 1642 CALL bdy_ctl_corn(npckge(ib), icorne(ib,1)) 1642 1643 itest=itest+1 … … 1652 1653 ELSE 1653 1654 ! This is a corner 1654 WRITE(numout,*) 'Found a North-East corner at (i,j): ', jpieob(ib)+1, jpjeft(ib)1655 IF(lwp) WRITE(numout,*) 'Found a North-East corner at (i,j): ', jpieob(ib)+1, jpjeft(ib) 1655 1656 CALL bdy_ctl_corn(npckge(ib), icorne(ib,2)) 1656 1657 itest=itest+1 -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r5565 r6204 1018 1018 CALL histdef( id_i, "vovvldep", "T point depth" , "m" , & ! t-point depth 1019 1019 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 1020 CALL histdef( id_i, "vovvle3t", "T point thickness" , "m" , & ! t-point depth 1021 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 1020 1022 END IF 1021 1023 … … 1048 1050 CALL histwrite( id_i, "sozotaux", kt, utau , jpi*jpj , idex ) ! i-wind stress 1049 1051 CALL histwrite( id_i, "sometauy", kt, vtau , jpi*jpj , idex ) ! j-wind stress 1052 IF( lk_vvl ) THEN 1053 CALL histwrite( id_i, "vovvldep", kt, fsdept_n(:,:,:), jpi*jpj*jpk, idex )! T-cell depth 1054 CALL histwrite( id_i, "vovvle3t", kt, fse3t_n (:,:,:), jpi*jpj*jpk, idex )! T-cell thickness 1055 END IF 1050 1056 1051 1057 ! 3. Close the file -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90
r5551 r6204 544 544 IF ( cp_cfg == 'eel' .AND. jp_cfg == 6 ) THEN ! for EEL6 configuration only 545 545 IF( .NOT. Agrif_Root() ) THEN 546 zphi0 = ppgphi0 - FLOAT( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m) / (ra * rad) 546 zphi0 = ppgphi0 - FLOAT( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m) & 547 & / (ra * rad) 547 548 ENDIF 548 549 ENDIF -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r6036 r6204 219 219 & ppsur == pp_to_be_computed ) THEN 220 220 ! 221 #if defined key_agrif 222 za1 = ( ppdzmin - pphmax / FLOAT(jpkdta-1) ) & 223 & / ( TANH((1-ppkth)/ppacr) - ppacr/FLOAT(jpkdta-1) * ( LOG( COSH( (jpkdta - ppkth) / ppacr) )& 224 & - LOG( COSH( ( 1 - ppkth) / ppacr) ) ) ) 225 #else 221 226 za1 = ( ppdzmin - pphmax / FLOAT(jpkm1) ) & 222 227 & / ( TANH((1-ppkth)/ppacr) - ppacr/FLOAT(jpk-1) * ( LOG( COSH( (jpk - ppkth) / ppacr) ) & 223 228 & - LOG( COSH( ( 1 - ppkth) / ppacr) ) ) ) 229 #endif 224 230 za0 = ppdzmin - za1 * TANH( (1-ppkth) / ppacr ) 225 231 zsur = - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr ) ) … … 236 242 WRITE(numout,*) ' Uniform grid with ',jpk-1,' layers' 237 243 WRITE(numout,*) ' Total depth :', zhmax 244 #if defined key_agrif 245 WRITE(numout,*) ' Layer thickness:', zhmax/(jpkdta-1) 246 #else 238 247 WRITE(numout,*) ' Layer thickness:', zhmax/(jpk-1) 248 #endif 239 249 ELSE 240 250 IF( ppa1 == 0._wp .AND. ppa0 == 0._wp .AND. ppsur == 0._wp ) THEN … … 260 270 ! Reference z-coordinate (depth - scale factor at T- and W-points) 261 271 ! ====================== 262 IF( ppkth == 0._wp ) THEN ! uniform vertical grid 272 IF( ppkth == 0._wp ) THEN ! uniform vertical grid 273 #if defined key_agrif 274 za1 = zhmax / FLOAT(jpkdta-1) 275 #else 263 276 za1 = zhmax / FLOAT(jpk-1) 277 #endif 264 278 DO jk = 1, jpk 265 279 zw = FLOAT( jk ) -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90
r5516 r6204 97 97 IF( nn_timing == 1 ) CALL timing_start('div_cur') 98 98 ! 99 CALL wrk_alloc( jpi , jpj+2, zwu 100 CALL wrk_alloc( jpi+ 4, jpj , zwv, kistart = -1)99 CALL wrk_alloc( jpi , jpj+2, zwu ) 100 CALL wrk_alloc( jpi+2, jpj , zwv ) 101 101 ! 102 102 IF( kt == nit000 ) THEN … … 236 236 CALL lbc_lnk( hdivn, 'T', 1. ) ; CALL lbc_lnk( rotn , 'F', 1. ) ! lateral boundary cond. (no sign change) 237 237 ! 238 CALL wrk_dealloc( jpi , jpj+2, zwu 239 CALL wrk_dealloc( jpi+ 4, jpj , zwv, kistart = -1)238 CALL wrk_dealloc( jpi , jpj+2, zwu ) 239 CALL wrk_dealloc( jpi+2, jpj , zwv ) 240 240 ! 241 241 IF( nn_timing == 1 ) CALL timing_stop('div_cur') -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r5912 r6204 465 465 ENDIF 466 466 #endif 467 ! !* Fill boundary data arrays withAGRIF468 ! ! ------------------------------------ -467 ! !* Fill boundary data arrays for AGRIF 468 ! ! ------------------------------------ 469 469 #if defined key_agrif 470 470 IF( .NOT.Agrif_Root() ) CALL agrif_dta_ts( kt ) … … 900 900 #if defined key_agrif 901 901 ! Save time integrated fluxes during child grid integration 902 ! (used to update coarse grid transports) 903 ! Useless with 2nd order momentum schemes 902 ! (used to update coarse grid transports at next time step) 904 903 ! 905 904 IF ( (.NOT.Agrif_Root()).AND.(ln_bt_fw) ) THEN -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
r5628 r6204 31 31 USE bdydyn2d ! bdy_ssh routine 32 32 #if defined key_agrif 33 USE agrif_opa_update34 33 USE agrif_opa_interp 35 34 #endif … … 274 273 ENDIF 275 274 ! 276 ! Update velocity at AGRIF zoom boundaries277 #if defined key_agrif278 IF ( .NOT.Agrif_Root() ) CALL Agrif_Update_Dyn( kt )279 #endif280 !281 275 IF(ln_ctl) CALL prt_ctl( tab2d_1=sshb, clinfo1=' sshb - : ', mask1=tmask, ovlap=1 ) 282 276 ! -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r5426 r6204 94 94 CHARACTER(len=*), INTENT(in) :: cdname 95 95 #if defined key_iomput 96 TYPE(xios_time) :: dtime = xios_time(0, 0, 0, 0, 0, 0) 97 CHARACTER(len=19) :: cldate 98 CHARACTER(len=10) :: clname 99 INTEGER :: ji 96 #if ! defined key_xios2 97 TYPE(xios_time) :: dtime = xios_time(0, 0, 0, 0, 0, 0) 98 CHARACTER(len=19) :: cldate 99 #else 100 TYPE(xios_duration) :: dtime = xios_duration(0, 0, 0, 0, 0, 0) 101 TYPE(xios_date) :: start_date 102 #endif 103 CHARACTER(len=10) :: clname 104 INTEGER :: ji 100 105 ! 101 106 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_bnds 102 107 !!---------------------------------------------------------------------- 103 108 #if ! defined key_xios2 104 109 ALLOCATE( z_bnds(jpk,2) ) 110 #else 111 ALLOCATE( z_bnds(2,jpk) ) 112 #endif 105 113 106 114 clname = cdname … … 110 118 111 119 ! calendar parameters 120 #if ! defined key_xios2 112 121 SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL 113 122 CASE ( 1) ; CALL xios_set_context_attr(TRIM(clname), calendar_type= "Gregorian") … … 117 126 WRITE(cldate,"(i4.4,'-',i2.2,'-',i2.2,' 00:00:00')") nyear,nmonth,nday 118 127 CALL xios_set_context_attr(TRIM(clname), start_date=cldate ) 119 128 #else 129 ! Calendar type is now defined in xml file 130 SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL 131 CASE ( 1) ; CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date(1900,01,01,00,00,00), & 132 & start_date = xios_date(nyear,nmonth,nday,0,0,0) ) 133 CASE ( 0) ; CALL xios_define_calendar( TYPE = "NoLeap" , time_origin = xios_date(1900,01,01,00,00,00), & 134 & start_date = xios_date(nyear,nmonth,nday,0,0,0) ) 135 CASE (30) ; CALL xios_define_calendar( TYPE = "D360" , time_origin = xios_date(1900,01,01,00,00,00), & 136 & start_date = xios_date(nyear,nmonth,nday,0,0,0) ) 137 END SELECT 138 #endif 120 139 ! horizontal grid definition 140 141 #if ! defined key_xios2 121 142 CALL set_scalar 143 #endif 122 144 123 145 IF( TRIM(cdname) == TRIM(cxios_context) ) THEN … … 170 192 171 193 ! Add vertical grid bounds 194 #if ! defined key_xios2 172 195 z_bnds(: ,1) = gdepw_1d(:) 173 196 z_bnds(1:jpkm1,2) = gdepw_1d(2:jpk) 174 197 z_bnds(jpk: ,2) = gdepw_1d(jpk) + e3t_1d(jpk) 198 #else 199 z_bnds(1 ,:) = gdepw_1d(:) 200 z_bnds(2,1:jpkm1) = gdepw_1d(2:jpk) 201 z_bnds(2,jpk: ) = gdepw_1d(jpk) + e3t_1d(jpk) 202 #endif 203 175 204 CALL iom_set_axis_attr( "deptht", bounds=z_bnds ) 176 205 CALL iom_set_axis_attr( "depthu", bounds=z_bnds ) 177 206 CALL iom_set_axis_attr( "depthv", bounds=z_bnds ) 178 z_bnds(: ,2) = gdept_1d(:) 179 z_bnds(2:jpk,1) = gdept_1d(1:jpkm1) 180 z_bnds(1 ,1) = gdept_1d(1) - e3w_1d(1) 207 208 #if ! defined key_xios2 209 z_bnds(: ,2) = gdept_1d(:) 210 z_bnds(2:jpk,1) = gdept_1d(1:jpkm1) 211 z_bnds(1 ,1) = gdept_1d(1) - e3w_1d(1) 212 #else 213 z_bnds(2,: ) = gdept_1d(:) 214 z_bnds(1,2:jpk) = gdept_1d(1:jpkm1) 215 z_bnds(1,1 ) = gdept_1d(1) - e3w_1d(1) 216 #endif 181 217 CALL iom_set_axis_attr( "depthw", bounds=z_bnds ) 218 182 219 183 220 # if defined key_floats … … 1158 1195 LOGICAL, DIMENSION(:,:) , OPTIONAL, INTENT(in) :: mask 1159 1196 1197 #if ! defined key_xios2 1160 1198 IF ( xios_is_valid_domain (cdid) ) THEN 1161 1199 CALL xios_set_domain_attr ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & … … 1164 1202 & lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon, & 1165 1203 & bounds_lat=bounds_lat, area=area ) 1166 ENDIF 1167 1204 ENDIF 1168 1205 IF ( xios_is_valid_domaingroup(cdid) ) THEN 1169 1206 CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & … … 1173 1210 & bounds_lat=bounds_lat, area=area ) 1174 1211 ENDIF 1212 1213 #else 1214 IF ( xios_is_valid_domain (cdid) ) THEN 1215 CALL xios_set_domain_attr ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & 1216 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , & 1217 & lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_2D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon, & 1218 & bounds_lat_1D=bounds_lat, area=area, type='curvilinear') 1219 ENDIF 1220 IF ( xios_is_valid_domaingroup(cdid) ) THEN 1221 CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & 1222 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , & 1223 & lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_2D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon, & 1224 & bounds_lat_1D=bounds_lat, area=area, type='curvilinear' ) 1225 ENDIF 1226 #endif 1175 1227 CALL xios_solve_inheritance() 1176 1228 1177 1229 END SUBROUTINE iom_set_domain_attr 1230 1231 #if defined key_xios2 1232 SUBROUTINE iom_set_zoom_domain_attr( cdid, ibegin, jbegin, ni, nj) 1233 CHARACTER(LEN=*) , INTENT(in) :: cdid 1234 INTEGER , OPTIONAL, INTENT(in) :: ibegin, jbegin, ni, nj 1235 1236 IF ( xios_is_valid_domain (cdid) ) THEN 1237 CALL xios_set_zoom_domain_attr ( cdid, ibegin=ibegin, jbegin=jbegin, ni=ni, & 1238 & nj=nj) 1239 ENDIF 1240 END SUBROUTINE iom_set_zoom_domain_attr 1241 #endif 1178 1242 1179 1243 … … 1183 1247 REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) :: bounds 1184 1248 IF ( PRESENT(paxis) ) THEN 1249 #if ! defined key_xios2 1185 1250 IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, size=SIZE(paxis), value=paxis ) 1186 1251 IF ( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, size=SIZE(paxis), value=paxis ) 1252 #else 1253 IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, n_glo=SIZE(paxis), value=paxis ) 1254 IF ( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=paxis ) 1255 #endif 1187 1256 ENDIF 1188 1257 IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, bounds=bounds ) … … 1191 1260 END SUBROUTINE iom_set_axis_attr 1192 1261 1193 1194 1262 SUBROUTINE iom_set_field_attr( cdid, freq_op, freq_offset ) 1195 1263 CHARACTER(LEN=*) , INTENT(in) :: cdid 1196 CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: freq_op 1197 CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: freq_offset 1198 IF ( xios_is_valid_field (cdid) ) CALL xios_set_field_attr ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1199 IF ( xios_is_valid_fieldgroup(cdid) ) CALL xios_set_fieldgroup_attr( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1264 #if ! defined key_xios2 1265 CHARACTER(LEN=*) ,OPTIONAL , INTENT(in) :: freq_op 1266 CHARACTER(LEN=*) ,OPTIONAL , INTENT(in) :: freq_offset 1267 #else 1268 TYPE(xios_duration),OPTIONAL , INTENT(in) :: freq_op 1269 TYPE(xios_duration),OPTIONAL , INTENT(in) :: freq_offset 1270 #endif 1271 IF ( xios_is_valid_field (cdid) ) CALL xios_set_field_attr & 1272 & ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1273 IF ( xios_is_valid_fieldgroup(cdid) ) CALL xios_set_fieldgroup_attr & 1274 & ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1200 1275 CALL xios_solve_inheritance() 1201 1276 END SUBROUTINE iom_set_field_attr 1202 1203 1277 1204 1278 SUBROUTINE iom_set_file_attr( cdid, name, name_suffix ) … … 1213 1287 SUBROUTINE iom_get_file_attr( cdid, name, name_suffix, output_freq ) 1214 1288 CHARACTER(LEN=*) , INTENT(in ) :: cdid 1215 CHARACTER(LEN=*),OPTIONAL , INTENT(out) :: name, name_suffix, output_freq 1289 CHARACTER(LEN=*),OPTIONAL , INTENT(out) :: name, name_suffix 1290 #if ! defined key_xios2 1291 CHARACTER(LEN=*),OPTIONAL , INTENT(out) :: output_freq 1292 #else 1293 TYPE(xios_duration) ,OPTIONAL , INTENT(out) :: output_freq 1294 #endif 1216 1295 LOGICAL :: llexist1,llexist2,llexist3 1217 1296 !--------------------------------------------------------------------- 1218 1297 IF( PRESENT( name ) ) name = '' ! default values 1219 1298 IF( PRESENT( name_suffix ) ) name_suffix = '' 1299 #if ! defined key_xios2 1220 1300 IF( PRESENT( output_freq ) ) output_freq = '' 1301 #else 1302 IF( PRESENT( output_freq ) ) output_freq = xios_duration(0,0,0,0,0,0) 1303 #endif 1221 1304 IF ( xios_is_valid_file (cdid) ) THEN 1222 1305 CALL xios_solve_inheritance() … … 1239 1322 CHARACTER(LEN=*) , INTENT(in) :: cdid 1240 1323 LOGICAL, DIMENSION(:,:,:), OPTIONAL, INTENT(in) :: mask 1324 #if ! defined key_xios2 1241 1325 IF ( xios_is_valid_grid (cdid) ) CALL xios_set_grid_attr ( cdid, mask=mask ) 1242 1326 IF ( xios_is_valid_gridgroup(cdid) ) CALL xios_set_gridgroup_attr( cdid, mask=mask ) 1327 #else 1328 IF ( xios_is_valid_grid (cdid) ) CALL xios_set_grid_attr ( cdid, mask3=mask ) 1329 IF ( xios_is_valid_gridgroup(cdid) ) CALL xios_set_gridgroup_attr( cdid, mask3=mask ) 1330 #endif 1243 1331 CALL xios_solve_inheritance() 1244 1332 END SUBROUTINE iom_set_grid_attr … … 1282 1370 ni=nlei-nldi+1 ; nj=nlej-nldj+1 1283 1371 1284 CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj) 1372 #if ! defined key_xios2 1373 CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj) 1374 #else 1375 CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 1376 #endif 1285 1377 CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 1286 1378 CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)), & … … 1430 1522 ALLOCATE( zlon(ni*nj) ) ; zlon(:) = 0. 1431 1523 1524 CALL dom_ngb( 180., 90., ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots) 1525 #if ! defined key_xios2 1432 1526 CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj) 1433 1527 CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) … … 1435 1529 & latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /))) 1436 1530 ! 1437 CALL dom_ngb( 180., 90., ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots)1438 1531 CALL iom_set_domain_attr ('ptr', zoom_ibegin=ix, zoom_nj=jpjglo) 1532 #else 1533 ! Pas teste : attention aux indices ! 1534 CALL iom_set_domain_attr("ptr", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 1535 CALL iom_set_domain_attr("ptr", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 1536 CALL iom_set_domain_attr("ptr", lonvalue = zlon, & 1537 & latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /))) 1538 CALL iom_set_zoom_domain_attr ('ptr', ibegin=ix, nj=jpjglo) 1539 #endif 1540 1439 1541 CALL iom_update_file_name('ptr') 1440 1542 ! … … 1455 1557 zz=REAL(narea,wp) 1456 1558 CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz) 1457 1559 1458 1560 END SUBROUTINE set_scalar 1459 1561 … … 1479 1581 REAL(wp) ,DIMENSION( 3) :: zlonpira ! longitudes of pirata moorings 1480 1582 REAL(wp) ,DIMENSION( 9) :: zlatpira ! latitudes of pirata moorings 1583 #if defined key_xios2 1584 TYPE(xios_duration) :: f_op, f_of 1585 #endif 1586 1481 1587 !!---------------------------------------------------------------------- 1482 1588 ! 1483 1589 ! frequency of the call of iom_put (attribut: freq_op) 1484 WRITE(cl1,'(i1)') 1 ; CALL iom_set_field_attr('field_definition', freq_op = cl1//'ts', freq_offset='0ts') 1485 WRITE(cl1,'(i1)') nn_fsbc ; CALL iom_set_field_attr('SBC' , freq_op = cl1//'ts', freq_offset='0ts') 1486 WRITE(cl1,'(i1)') nn_fsbc ; CALL iom_set_field_attr('SBC_scalar' , freq_op = cl1//'ts', freq_offset='0ts') 1487 WRITE(cl1,'(i1)') nn_dttrc ; CALL iom_set_field_attr('ptrc_T' , freq_op = cl1//'ts', freq_offset='0ts') 1488 WRITE(cl1,'(i1)') nn_dttrc ; CALL iom_set_field_attr('diad_T' , freq_op = cl1//'ts', freq_offset='0ts') 1590 #if ! defined key_xios2 1591 WRITE(cl1,'(i1)') 1 ; CALL iom_set_field_attr('field_definition', freq_op=cl1//'ts', freq_offset='0ts') 1592 WRITE(cl1,'(i1)') nn_fsbc ; CALL iom_set_field_attr('SBC' , freq_op=cl1//'ts', freq_offset='0ts') 1593 WRITE(cl1,'(i1)') nn_fsbc ; CALL iom_set_field_attr('SBC_scalar' , freq_op=cl1//'ts', freq_offset='0ts') 1594 WRITE(cl1,'(i1)') nn_dttrc ; CALL iom_set_field_attr('ptrc_T' , freq_op=cl1//'ts', freq_offset='0ts') 1595 WRITE(cl1,'(i1)') nn_dttrc ; CALL iom_set_field_attr('diad_T' , freq_op=cl1//'ts', freq_offset='0ts') 1596 #else 1597 f_op%timestep = 1 ; f_of%timestep = 0 ; CALL iom_set_field_attr('field_definition', freq_op=f_op, freq_offset=f_of) 1598 f_op%timestep = nn_fsbc ; f_of%timestep = 0 ; CALL iom_set_field_attr('SBC' , freq_op=f_op, freq_offset=f_of) 1599 f_op%timestep = nn_fsbc ; f_of%timestep = 0 ; CALL iom_set_field_attr('SBC_scalar' , freq_op=f_op, freq_offset=f_of) 1600 f_op%timestep = nn_dttrc ; f_of%timestep = 0 ; CALL iom_set_field_attr('ptrc_T' , freq_op=f_op, freq_offset=f_of) 1601 f_op%timestep = nn_dttrc ; f_of%timestep = 0 ; CALL iom_set_field_attr('diad_T' , freq_op=f_op, freq_offset=f_of) 1602 #endif 1489 1603 1490 1604 ! output file names (attribut: name) … … 1508 1622 ! Equatorial section (attributs: jbegin, ni, name_suffix) 1509 1623 CALL dom_ngb( 0., 0., ix, iy, cl1 ) 1624 #if ! defined key_xios2 1510 1625 CALL iom_set_domain_attr ('Eq'//cl1, zoom_jbegin=iy, zoom_ni=jpiglo) 1626 #else 1627 CALL iom_set_zoom_domain_attr ('Eq'//cl1, jbegin=iy-1, ni=jpiglo) 1628 #endif 1511 1629 CALL iom_get_file_attr ('Eq'//cl1, name_suffix = clsuff ) 1512 1630 CALL iom_set_file_attr ('Eq'//cl1, name_suffix = TRIM(clsuff)//'_Eq') … … 1588 1706 ENDIF 1589 1707 clname = TRIM(ADJUSTL(clat))//TRIM(ADJUSTL(clon)) 1708 #if ! defined key_xios2 1590 1709 CALL iom_set_domain_attr (TRIM(clname)//cl1, zoom_ibegin= ix, zoom_jbegin= iy) 1710 #else 1711 CALL iom_set_zoom_domain_attr (TRIM(clname)//cl1, ibegin= ix-1, jbegin= iy-1) 1712 #endif 1591 1713 CALL iom_get_file_attr (TRIM(clname)//cl1, name_suffix = clsuff ) 1592 1714 CALL iom_set_file_attr (TRIM(clname)//cl1, name_suffix = TRIM(clsuff)//'_'//TRIM(clname)) … … 1617 1739 REAL(wp) :: zsec 1618 1740 LOGICAL :: llexist 1619 !!---------------------------------------------------------------------- 1741 #if defined key_xios2 1742 TYPE(xios_duration) :: output_freq 1743 #endif 1744 !!---------------------------------------------------------------------- 1745 1620 1746 1621 1747 DO jn = 1,2 1622 1748 #if ! defined key_xios2 1623 1749 IF( jn == 1 ) CALL iom_get_file_attr( cdid, name = clname, output_freq = clfreq ) 1750 #else 1751 output_freq = xios_duration(0,0,0,0,0,0) 1752 IF( jn == 1 ) CALL iom_get_file_attr( cdid, name = clname, output_freq = output_freq ) 1753 #endif 1624 1754 IF( jn == 2 ) CALL iom_get_file_attr( cdid, name_suffix = clname ) 1625 1755 … … 1632 1762 END DO 1633 1763 1764 #if ! defined key_xios2 1634 1765 idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 1635 1766 DO WHILE ( idx /= 0 ) … … 1644 1775 idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 1645 1776 END DO 1646 1777 #else 1778 idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 1779 DO WHILE ( idx /= 0 ) 1780 IF ( output_freq%hour /= 0 ) THEN 1781 WRITE(clfreq,'(I19,A1)')INT(output_freq%hour),'h' 1782 itrlen = LEN_TRIM(ADJUSTL(clfreq)) 1783 ELSE IF ( output_freq%day /= 0 ) THEN 1784 WRITE(clfreq,'(I19,A1)')INT(output_freq%day),'d' 1785 itrlen = LEN_TRIM(ADJUSTL(clfreq)) 1786 ELSE IF ( output_freq%month /= 0 ) THEN 1787 WRITE(clfreq,'(I19,A1)')INT(output_freq%month),'m' 1788 itrlen = LEN_TRIM(ADJUSTL(clfreq)) 1789 ELSE IF ( output_freq%year /= 0 ) THEN 1790 WRITE(clfreq,'(I19,A1)')INT(output_freq%year),'y' 1791 itrlen = LEN_TRIM(ADJUSTL(clfreq)) 1792 ELSE 1793 CALL ctl_stop('error in the name of file id '//TRIM(cdid), & 1794 & ' attribute output_freq is undefined -> cannot replace @freq@ in '//TRIM(clname) ) 1795 ENDIF 1796 clname = clname(1:idx-1)//TRIM(ADJUSTL(clfreq))//clname(idx+6:LEN_TRIM(clname)) 1797 idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 1798 END DO 1799 #endif 1647 1800 idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') 1648 1801 DO WHILE ( idx /= 0 ) … … 1673 1826 END DO 1674 1827 1828 IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 1675 1829 IF( jn == 1 ) CALL iom_set_file_attr( cdid, name = clname ) 1676 1830 IF( jn == 2 ) CALL iom_set_file_attr( cdid, name_suffix = clname ) … … 1720 1874 ENDIF 1721 1875 1876 !$AGRIF_DO_NOT_TREAT 1877 ! Should be fixed in the conv 1722 1878 IF( llfull ) THEN 1723 1879 clfmt = TRIM(clfmt)//",'_',i2.2,':',i2.2,':',i2.2" … … 1730 1886 WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday ! date of the end of run 1731 1887 ENDIF 1888 !$AGRIF_END_DO_NOT_TREAT 1732 1889 1733 1890 END FUNCTION iom_sdate -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r5429 r6204 298 298 ENDIF 299 299 300 #if defined key_agrif 301 IF (Agrif_Root()) THEN 302 CALL Agrif_MPI_Init(mpi_comm_opa) 303 ELSE 304 CALL Agrif_MPI_set_grid_comm(mpi_comm_opa) 305 ENDIF 306 #endif 307 300 308 CALL mpi_comm_rank( mpi_comm_opa, mpprank, ierr ) 301 309 CALL mpi_comm_size( mpi_comm_opa, mppsize, ierr ) -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
r5767 r6204 1290 1290 CHARACTER(LEN=*) , INTENT(in ) :: lsmfile ! land sea mask file name 1291 1291 !! 1292 REAL(wp),DIMENSION(:,:,:),ALLOCATABLE :: ztmp_fly_dta ,zfieldo! temporary array of values on input grid1292 REAL(wp),DIMENSION(:,:,:),ALLOCATABLE :: ztmp_fly_dta ! temporary array of values on input grid 1293 1293 INTEGER, DIMENSION(3) :: rec1,recn ! temporary arrays for start and length 1294 1294 INTEGER, DIMENSION(3) :: rec1_lsm,recn_lsm ! temporary arrays for start and length in case of seaoverland … … 1356 1356 1357 1357 1358 itmpi= SIZE(ztmp_fly_dta(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:),1)1359 itmpj= SIZE(ztmp_fly_dta(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:),2)1358 itmpi=jpi2_lsm-jpi1_lsm+1 1359 itmpj=jpj2_lsm-jpj1_lsm+1 1360 1360 itmpz=kk 1361 1361 ALLOCATE(ztmp_fly_dta(itmpi,itmpj,itmpz)) -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r5487 r6204 1029 1029 ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1) 1030 1030 ub (:,:,1) = ssu_m(:,:) ! will be used in sbcice_lim in the call of lim_sbc_tau 1031 un (:,:,1) = ssu_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling 1031 1032 CALL iom_put( 'ssu_m', ssu_m ) 1032 1033 ENDIF … … 1034 1035 ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1) 1035 1036 vb (:,:,1) = ssv_m(:,:) ! will be used in sbcice_lim in the call of lim_sbc_tau 1037 vn (:,:,1) = ssv_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling 1036 1038 CALL iom_put( 'ssv_m', ssv_m ) 1037 1039 ENDIF … … 1743 1745 ztmp3(:,:,1) = SUM( tn_ice * a_i, dim=3 ) / SUM( a_i, dim=3 ) 1744 1746 ELSEWHERE 1745 ztmp3(:,:,1) = rt0 ! TODO: Is freezing point a good default? (Maybe SST is better?)1747 ztmp3(:,:,1) = rt0 1746 1748 END WHERE 1747 1749 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) … … 1774 1776 ! ! ------------------------- ! 1775 1777 IF( ssnd(jps_albice)%laction ) THEN ! ice 1776 SELECT CASE( sn_snd_alb%cldes ) 1777 CASE( 'ice' ) ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) 1778 CASE( 'weighted ice' ) ; ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1779 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' ) 1778 SELECT CASE( sn_snd_alb%cldes ) 1779 CASE( 'ice' ) 1780 SELECT CASE( sn_snd_alb%clcat ) 1781 CASE( 'yes' ) 1782 ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) 1783 CASE( 'no' ) 1784 WHERE( SUM( a_i, dim=3 ) /= 0. ) 1785 ztmp1(:,:) = SUM( alb_ice (:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 ) / SUM( a_i(:,:,1:jpl), dim=3 ) 1786 ELSEWHERE 1787 ztmp1(:,:) = albedo_oce_mix(:,:) 1788 END WHERE 1789 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%clcat' ) 1790 END SELECT 1791 CASE( 'weighted ice' ) ; 1792 SELECT CASE( sn_snd_alb%clcat ) 1793 CASE( 'yes' ) 1794 ztmp3(:,:,1:jpl) = alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1795 CASE( 'no' ) 1796 WHERE( fr_i (:,:) > 0. ) 1797 ztmp1(:,:) = SUM ( alb_ice(:,:,1:jpl) * a_i(:,:,1:jpl), dim=3 ) 1798 ELSEWHERE 1799 ztmp1(:,:) = 0. 1800 END WHERE 1801 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_ice%clcat' ) 1802 END SELECT 1803 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_alb%cldes' ) 1780 1804 END SELECT 1781 CALL cpl_snd( jps_albice, isec, ztmp3, info ) 1782 ENDIF 1805 1806 SELECT CASE( sn_snd_alb%clcat ) 1807 CASE( 'yes' ) 1808 CALL cpl_snd( jps_albice, isec, ztmp3, info ) !-> MV this has never been checked in coupled mode 1809 CASE( 'no' ) 1810 CALL cpl_snd( jps_albice, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1811 END SELECT 1812 ENDIF 1813 1783 1814 IF( ssnd(jps_albmix)%laction ) THEN ! mixed ice-ocean 1784 1815 ztmp1(:,:) = albedo_oce_mix(:,:) * zfr_l(:,:) -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90
r5720 r6204 53 53 REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:) :: risfLeff !:effective length (Leff) BG03 nn_isf==2 54 54 REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:) :: ttbl, stbl, utbl, vtbl !:top boundary layer variable at T point 55 #if defined key_agrif56 ! AGRIF can not handle these arrays as integers. The reason is a mystery but problems avoided by declaring them as reals57 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:) :: misfkt, misfkb !:Level of ice shelf base58 !: (first wet level and last level include in the tbl)59 #else60 55 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:) :: misfkt, misfkb !:Level of ice shelf base 61 #endif62 56 63 57 -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
r5503 r6204 126 126 IF( ln_rnf_sal ) CALL fld_read ( kt, nn_fsbc, sf_s_rnf ) ! idem for runoffs salinity if required 127 127 ! 128 ! Runoff reduction only associated to the ORCA2_LIM configuration129 ! when reading the NetCDF file runoff_1m_nomask.nc130 IF( cp_cfg == 'orca' .AND. jp_cfg == 2 .AND. .NOT. l_rnfcpl ) THEN131 WHERE( 40._wp < gphit(:,:) .AND. gphit(:,:) < 65._wp )132 sf_rnf(1)%fnow(:,:,1) = 0.85 * sf_rnf(1)%fnow(:,:,1)133 END WHERE134 ENDIF135 !136 128 IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 137 129 ! -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90
r4990 r6204 212 212 CHARACTER(len=3) :: cdtype 213 213 REAL, DIMENSION(:,:,:) :: pun, pvn, pwn 214 WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', kt, cdtype, pun(1,1,1), pvn(1,1,1), pwn(1,1,1) 214 WRITE(*,*) 'tra_adv_eiv: You should not have seen this print! error?', & 215 & kt, cdtype, pun(1,1,1), pvn(1,1,1), pwn(1,1,1) 215 216 END SUBROUTINE tra_adv_eiv 216 217 #endif -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r5147 r6204 326 326 CALL wrk_alloc( jpi, jpj, zwx_sav, zwy_sav ) 327 327 CALL wrk_alloc( jpi, jpj, jpk, zwi, zwz , zhdiv, zwz_sav, zwzts ) 328 CALL wrk_alloc( jpi, jpj, jpk, 3, ztrs )328 CALL wrk_alloc( jpi, jpj, jpk, kjpt+1, ztrs ) 329 329 ! 330 330 IF( kt == kit000 ) THEN … … 564 564 ! 565 565 CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz, zhdiv, zwz_sav, zwzts ) 566 CALL wrk_dealloc( jpi, jpj, jpk, 3, ztrs )566 CALL wrk_dealloc( jpi, jpj, jpk, kjpt+1, ztrs ) 567 567 CALL wrk_dealloc( jpi, jpj, zwx_sav, zwy_sav ) 568 568 IF( l_trd ) CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
r5628 r6204 47 47 USE timing ! Timing 48 48 #if defined key_agrif 49 USE agrif_opa_update50 49 USE agrif_opa_interp 51 50 #endif … … 111 110 ! Update after tracer on domain lateral boundaries 112 111 ! 112 #if defined key_agrif 113 CALL Agrif_tra ! AGRIF zoom boundaries 114 #endif 115 ! 113 116 CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1._wp ) ! local domain boundaries (T-point, unchanged sign) 114 117 CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1._wp ) … … 116 119 #if defined key_bdy 117 120 IF( lk_bdy ) CALL bdy_tra( kt ) ! BDY open boundaries 118 #endif119 #if defined key_agrif120 CALL Agrif_tra ! AGRIF zoom boundaries121 121 #endif 122 122 … … 149 149 ELSE ; CALL tra_nxt_fix( kt, nit000, 'TRA', tsb, tsn, tsa, jpts ) ! fixed volume level 150 150 ENDIF 151 ENDIF 152 ! 153 #if defined key_agrif 154 ! Update tracer at AGRIF zoom boundaries 155 IF( .NOT.Agrif_Root() ) CALL Agrif_Update_Tra( kt ) ! children only 156 #endif 157 ! 158 ! trends computation 151 ENDIF 152 ! 153 ! trends computation 159 154 IF( l_trdtra ) THEN ! trend of the Asselin filter (tb filtered - tb)/dt 160 155 DO jk = 1, jpkm1 -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90
r5215 r6204 117 117 ! 118 118 SELECT CASE( ktrd ) 119 120 121 122 123 124 125 126 127 128 119 CASE( jpdyn_hpg ) ; CALL iom_put( "ketrd_hpg", zke ) ! hydrostatic pressure gradient 120 CASE( jpdyn_spg ) ; CALL iom_put( "ketrd_spg", zke ) ! surface pressure gradient 121 CASE( jpdyn_spgexp ); CALL iom_put( "ketrd_spgexp", zke ) ! surface pressure gradient (explicit) 122 CASE( jpdyn_spgflt ); CALL iom_put( "ketrd_spgflt", zke ) ! surface pressure gradient (filter) 123 CASE( jpdyn_pvo ) ; CALL iom_put( "ketrd_pvo", zke ) ! planetary vorticity 124 CASE( jpdyn_rvo ) ; CALL iom_put( "ketrd_rvo", zke ) ! relative vorticity (or metric term) 125 CASE( jpdyn_keg ) ; CALL iom_put( "ketrd_keg", zke ) ! Kinetic Energy gradient (or had) 126 CASE( jpdyn_zad ) ; CALL iom_put( "ketrd_zad", zke ) ! vertical advection 127 CASE( jpdyn_ldf ) ; CALL iom_put( "ketrd_ldf", zke ) ! lateral diffusion 128 CASE( jpdyn_zdf ) ; CALL iom_put( "ketrd_zdf", zke ) ! vertical diffusion 129 129 ! ! wind stress trends 130 131 132 133 134 135 136 137 138 139 140 141 142 130 CALL wrk_alloc( jpi, jpj, z2dx, z2dy, zke2d ) 131 z2dx(:,:) = un(:,:,1) * ( utau_b(:,:) + utau(:,:) ) * e1u(:,:) * e2u(:,:) * umask(:,:,1) 132 z2dy(:,:) = vn(:,:,1) * ( vtau_b(:,:) + vtau(:,:) ) * e1v(:,:) * e2v(:,:) * vmask(:,:,1) 133 zke2d(1,:) = 0._wp ; zke2d(:,1) = 0._wp 134 DO jj = 2, jpj 135 DO ji = 2, jpi 136 zke2d(ji,jj) = 0.5_wp * ( z2dx(ji,jj) + z2dx(ji-1,jj) & 137 & + z2dy(ji,jj) + z2dy(ji,jj-1) ) * r1_bt(ji,jj,1) 138 END DO 139 END DO 140 CALL iom_put( "ketrd_tau", zke2d ) 141 CALL wrk_dealloc( jpi, jpj , z2dx, z2dy, zke2d ) 142 CASE( jpdyn_bfr ) ; CALL iom_put( "ketrd_bfr", zke ) ! bottom friction (explicit case) 143 143 !!gm TO BE DONE properly 144 144 !!gm only valid if ln_bfrimp=F otherwise the bottom stress as to be recomputed at the end of the computation.... … … 162 162 ! ENDIF 163 163 !!gm end 164 164 CASE( jpdyn_atf ) ; CALL iom_put( "ketrd_atf", zke ) ! asselin filter trends 165 165 !! a faire !!!! idee changer dynnxt pour avoir un appel a jpdyn_bfr avant le swap !!! 166 166 !! reflechir a une possible sauvegarde du "vrai" un,vn pour le calcul de atf.... … … 184 184 ! CALL iom_put( "ketrd_bfri", zke2d ) 185 185 ! ENDIF 186 187 188 189 190 191 192 193 186 CASE( jpdyn_ken ) ; ! kinetic energy 187 ! called in dynnxt.F90 before asselin time filter 188 ! with putrd=ua and pvtrd=va 189 zke(:,:,:) = 0.5_wp * zke(:,:,:) 190 CALL iom_put( "KE", zke ) 191 ! 192 CALL ken_p2k( kt , zke ) 193 CALL iom_put( "ketrd_convP2K", zke ) ! conversion -rau*g*w 194 194 ! 195 195 END SELECT -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90
r5215 r6204 165 165 166 166 167 168 167 SELECT CASE( ktrd ) 168 CASE( jptra_npc ) ! non-penetrative convection: regrouped with zdf 169 169 !!gm : to be completed ! 170 ! 170 ! IF( .... 171 171 !!gm end 172 173 172 CASE( jptra_zdfp ) ! iso-neutral diffusion: "pure" vertical diffusion 173 ! ! regroup iso-neutral diffusion in one term 174 174 tmltrd(:,:,jpmxl_ldf) = tmltrd(:,:,jpmxl_ldf) + ( tmltrd(:,:,jpmxl_zdf) - tmltrd(:,:,jpmxl_zdfp) ) 175 175 smltrd(:,:,jpmxl_ldf) = smltrd(:,:,jpmxl_ldf) + ( smltrd(:,:,jpmxl_zdf) - smltrd(:,:,jpmxl_zdfp) ) … … 811 811 812 812 813 813 nkstp = nit000 - 1 ! current time step indicator initialization 814 814 815 815 … … 851 851 IF( nn_ctls == 1 ) THEN 852 852 CALL ctl_opn( inum, 'ctlsurf_idx', 'OLD', 'UNFORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 853 READ ( inum ) nbol853 READ ( inum, * ) nbol 854 854 CLOSE( inum ) 855 855 END IF -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90
r5215 r6204 99 99 CALL wrk_alloc( jpi, jpj, z2d ) 100 100 z2d(:,:) = wn(:,:,1) * ( & 101 102 103 &) / fse3t(:,:,1)101 & - ( rab_n(:,:,1,jp_tem) + rab_pe(:,:,1,jp_tem) ) * tsn(:,:,1,jp_tem) & 102 & + ( rab_n(:,:,1,jp_sal) + rab_pe(:,:,1,jp_sal) ) * tsn(:,:,1,jp_sal) & 103 & ) / fse3t(:,:,1) 104 104 CALL iom_put( "petrd_sad" , z2d ) 105 105 CALL wrk_dealloc( jpi, jpj, z2d ) -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90
r4990 r6204 43 43 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: avmu , avmv !: vertical viscosity coef at uw- & vw-pts [m2/s] 44 44 REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: avm , avt !: vertical viscosity & diffusivity coef at w-pt [m2/s] 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avt_k , avm_k ! not enhanced Kz 46 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avmu_k, avmv_k ! not enhanced Kz 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: en !: now turbulent kinetic energy [m2/s2] 45 48 46 49 !!---------------------------------------------------------------------- … … 60 63 & tfrua(jpi, jpj), tfrva(jpi, jpj) , & 61 64 & avmu(jpi,jpj,jpk), avm(jpi,jpj,jpk) , & 62 & avmv(jpi,jpj,jpk), avt(jpi,jpj,jpk) , STAT = zdf_oce_alloc ) 65 & avmv (jpi,jpj,jpk), avt (jpi,jpj,jpk) , & 66 & avt_k (jpi,jpj,jpk), avm_k (jpi,jpj,jpk) , & 67 & avmu_k(jpi,jpj,jpk), avmv_k(jpi,jpj,jpk) , & 68 & en (jpi,jpj,jpk), STAT = zdf_oce_alloc ) 63 69 ! 64 70 IF( zdf_oce_alloc /= 0 ) CALL ctl_warn('zdf_oce_alloc: failed to allocate arrays') -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
r5610 r6204 42 42 LOGICAL , PUBLIC, PARAMETER :: lk_zdfgls = .TRUE. !: TKE vertical mixing flag 43 43 ! 44 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: en !: now turbulent kinetic energy45 44 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: mxln !: now mixing length 46 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: zwall !: wall function 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avt_k ! not enhanced Kz48 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avm_k ! not enhanced Kz49 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avmu_k ! not enhanced Kz50 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avmv_k ! not enhanced Kz51 46 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ustars2 !: Squared surface velocity scale at T-points 52 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ustarb2 !: Squared bottom velocity scale at T-points … … 120 115 !! *** FUNCTION zdf_gls_alloc *** 121 116 !!---------------------------------------------------------------------- 122 ALLOCATE( en(jpi,jpj,jpk), mxln(jpi,jpj,jpk), zwall(jpi,jpj,jpk) , & 123 & avt_k (jpi,jpj,jpk) , avm_k (jpi,jpj,jpk), & 124 & avmu_k(jpi,jpj,jpk) , avmv_k(jpi,jpj,jpk), & 125 & ustars2(jpi,jpj), ustarb2(jpi,jpj) , STAT= zdf_gls_alloc ) 117 ALLOCATE( mxln(jpi,jpj,jpk), zwall(jpi,jpj,jpk) , & 118 & ustars2(jpi,jpj) , ustarb2(jpi,jpj) , STAT= zdf_gls_alloc ) 126 119 ! 127 120 IF( lk_mpp ) CALL mpp_sum ( zdf_gls_alloc ) -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90
r5938 r6204 27 27 28 28 PUBLIC zdf_mxl ! called by step.F90 29 PUBLIC zdf_mxl_alloc ! Used in zdf_tke_init 29 30 30 31 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: nmln !: number of level in the mixed layer (used by TOP) -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r6113 r6204 53 53 USE timing ! Timing 54 54 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 55 #if defined key_agrif 56 USE agrif_opa_interp 57 USE agrif_opa_update 58 #endif 59 60 55 61 56 62 IMPLICIT NONE … … 85 91 REAL(wp) :: rhftau_scl = 1.0_wp ! scale factor applied to HF part of taum (nn_etau=3) 86 92 87 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: en !: now turbulent kinetic energy [m2/s2]88 93 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: htau ! depth of tke penetration (nn_htau) 89 94 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dissl ! now mixing lenght of dissipation 90 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avt_k , avm_k ! not enhanced Kz91 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avmu_k, avmv_k ! not enhanced Kz92 95 #if defined key_c1d 93 96 ! !!** 1D cfg only ** ('key_c1d') … … 115 118 & e_pdl(jpi,jpj,jpk) , e_ric(jpi,jpj,jpk) , & 116 119 #endif 117 & en (jpi,jpj,jpk) , htau (jpi,jpj) , dissl(jpi,jpj,jpk) , & 118 & avt_k (jpi,jpj,jpk) , avm_k (jpi,jpj,jpk), & 119 & avmu_k(jpi,jpj,jpk) , avmv_k(jpi,jpj,jpk), STAT= zdf_tke_alloc ) 120 & htau (jpi,jpj) , dissl(jpi,jpj,jpk) , STAT= zdf_tke_alloc ) 120 121 ! 121 122 IF( lk_mpp ) CALL mpp_sum ( zdf_tke_alloc ) … … 189 190 avmv_k(:,:,:) = avmv(:,:,:) 190 191 ! 192 #if defined key_agrif 193 ! Update child grid f => parent grid 194 IF( .NOT.Agrif_Root() ) CALL Agrif_Update_Tke( kt ) ! children only 195 #endif 196 ! 191 197 END SUBROUTINE zdf_tke 192 198 … … 317 323 zwlc = zind * rn_lc * zus * SIN( rpi * fsdepw(ji,jj,jk) / zhlc(ji,jj) ) 318 324 ! ! TKE Langmuir circulation source term 319 en(ji,jj,jk) = en(ji,jj,jk) + rdt * ( 1._wp - fr_i(ji,jj) ) * ( zwlc * zwlc * zwlc ) / zhlc(ji,jj) * wmask(ji,jj,jk) * tmask(ji,jj,1) 325 en(ji,jj,jk) = en(ji,jj,jk) + rdt * ( 1._wp - fr_i(ji,jj) ) * ( zwlc * zwlc * zwlc ) / & 326 & zhlc(ji,jj) * wmask(ji,jj,jk) * tmask(ji,jj,1) 320 327 END DO 321 328 END DO … … 710 717 !!---------------------------------------------------------------------- 711 718 INTEGER :: ji, jj, jk ! dummy loop indices 712 INTEGER :: ios 719 INTEGER :: ios, ierr 713 720 !! 714 721 NAMELIST/namzdf_tke/ rn_ediff, rn_ediss , rn_ebb , rn_emin , & … … 768 775 ENDIF 769 776 770 IF( nn_etau == 2 ) CALL zdf_mxl( nit000 ) ! Initialization of nmln 777 IF( nn_etau == 2 ) THEN 778 ierr = zdf_mxl_alloc() 779 nmln(:,:) = nlb10 ! Initialization of nmln 780 ENDIF 771 781 772 782 ! !* depth of penetration of surface tke -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r5531 r6204 161 161 ENDIF 162 162 163 #if defined key_agrif 164 CALL Agrif_Regrid() 165 #endif 166 163 167 DO WHILE ( istp <= nitend .AND. nstop == 0 ) 164 168 #if defined key_agrif 165 CALL Agrif_Step( stp )! AGRIF: time stepping169 CALL stp ! AGRIF: time stepping 166 170 #else 167 171 CALL stp( istp ) ! standard time stepping … … 187 191 ! 188 192 #if defined key_agrif 189 IF ( Agrif_Level() < Agrif_MaxLevel() ) THEN193 IF( .NOT. Agrif_Root() ) THEN 190 194 CALL Agrif_ParentGrid_To_ChildGrid() 191 195 IF( lk_diaobs ) CALL dia_obs_wri … … 336 340 jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 337 341 #endif 338 ENDIF 342 ENDIF 339 343 jpk = jpkdta ! third dim 344 #if defined key_agrif 345 ! simple trick to use same vertical grid as parent 346 ! but different number of levels: 347 ! Save maximum number of levels in jpkdta, then define all vertical grids 348 ! with this number. 349 ! Suppress once vertical online interpolation is ok 350 IF(.NOT.Agrif_Root()) jpkdta = Agrif_Parent(jpkdta) 351 #endif 340 352 jpim1 = jpi-1 ! inner domain indices 341 353 jpjm1 = jpj-1 ! " " … … 712 724 INTEGER :: ifac, jl, inu 713 725 INTEGER, PARAMETER :: ntest = 14 714 INTEGER :: ilfax(ntest) 715 ! 716 ! lfax contains the set of allowed factors. 717 data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256, & 718 & 128, 64, 32, 16, 8, 4, 2 / 719 !!---------------------------------------------------------------------- 726 INTEGER, DIMENSION(ntest) :: ilfax 727 ! 728 ! ilfax contains the set of allowed factors. 729 ilfax(:) = (/(2**jl,jl=ntest,1,-1)/) 730 !!---------------------------------------------------------------------- 731 ! ilfax contains the set of allowed factors. 732 ilfax(:) = (/(2**jl,jl=ntest,1,-1)/) 720 733 721 734 ! Clear the error flag and initialise output vars -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/step.F90
r5510 r6204 50 50 51 51 #if defined key_agrif 52 SUBROUTINE stp( )52 RECURSIVE SUBROUTINE stp( ) 53 53 INTEGER :: kstp ! ocean time-step index 54 54 #else … … 79 79 #if defined key_agrif 80 80 kstp = nit000 + Agrif_Nb_Step() 81 ! IF ( Agrif_Root() .and. lwp) Write(*,*) '---' 82 ! IF (lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp 81 IF ( lk_agrif_debug ) THEN 82 IF ( Agrif_Root() .and. lwp) Write(*,*) '---' 83 IF (lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp, 'int tstep',Agrif_NbStepint() 84 ENDIF 85 83 86 IF ( kstp == (nit000 + 1) ) lk_agrif_fstep = .FALSE. 87 84 88 # if defined key_iomput 85 89 IF( Agrif_Nbstepint() == 0 ) CALL iom_swap( cxios_context ) … … 110 114 ! Update stochastic parameters and random T/S fluctuations 111 115 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 112 CALL sto_par( kstp ) ! Stochastic parameters 116 IF( ln_sto_eos ) CALL sto_par( kstp ) ! Stochastic parameters 117 IF( ln_sto_eos ) CALL sto_pts( tsn ) ! Random T/S fluctuations 113 118 114 119 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 152 157 ! 153 158 IF( lk_ldfslp ) THEN ! slope of lateral mixing 154 IF(ln_sto_eos ) CALL sto_pts( tsn ) ! Random T/S fluctuations155 159 CALL eos( tsb, rhd, gdept_0(:,:,:) ) ! before in situ density 156 160 IF( ln_zps .AND. .NOT. ln_isfcav) & … … 188 192 ! Note that the computation of vertical velocity above, hence "after" sea level 189 193 ! is necessary to compute momentum advection for the rhs of barotropic loop: 190 IF(ln_sto_eos ) CALL sto_pts( tsn ) ! Random T/S fluctuations191 194 CALL eos ( tsn, rhd, rhop, fsdept_n(:,:,:) ) ! now in situ density for hpg computation 192 195 IF( ln_zps .AND. .NOT. ln_isfcav) & … … 200 203 ua(:,:,:) = 0.e0 ! set dynamics trends to zero 201 204 va(:,:,:) = 0.e0 202 IF( l n_asmiau .AND. &205 IF( lk_asminc .AND. ln_asmiau .AND. & 203 206 & ln_dyninc ) CALL dyn_asm_inc ( kstp ) ! apply dynamics assimilation increment 204 207 IF( ln_neptsimp ) CALL dyn_nept_cor ( kstp ) ! subtract Neptune velocities (simplified) … … 248 251 tsa(:,:,:,:) = 0.e0 ! set tracer trends to zero 249 252 250 IF( l n_asmiau .AND. &253 IF( lk_asminc .AND. ln_asmiau .AND. & 251 254 & ln_trainc ) CALL tra_asm_inc( kstp ) ! apply tracer assimilation increment 252 255 CALL tra_sbc ( kstp ) ! surface boundary condition … … 270 273 IF( ln_zdfnpc ) CALL tra_npc( kstp ) ! update after fields by non-penetrative convection 271 274 CALL tra_nxt( kstp ) ! tracer fields at next time step 272 IF( ln_sto_eos ) CALL sto_pts( tsn ) ! Random T/S fluctuations273 275 CALL eos ( tsa, rhd, rhop, fsdept_n(:,:,:) ) ! Time-filtered in situ density for hpg computation 274 276 IF( ln_zps .AND. .NOT. ln_isfcav) & … … 281 283 ELSE ! centered hpg (eos then time stepping) 282 284 IF ( .NOT. lk_dynspg_ts ) THEN ! eos already called in time-split case 283 IF( ln_sto_eos ) CALL sto_pts( tsn ) ! Random T/S fluctuations284 285 CALL eos ( tsn, rhd, rhop, fsdept_n(:,:,:) ) ! now in situ density for hpg computation 285 286 IF( ln_zps .AND. .NOT. ln_isfcav) & … … 314 315 va(:,:,:) = 0.e0 315 316 316 IF( l n_asmiau .AND. &317 IF( lk_asminc .AND. ln_asmiau .AND. & 317 318 & ln_dyninc ) CALL dyn_asm_inc( kstp ) ! apply dynamics assimilation increment 318 319 IF( ln_bkgwri ) CALL asm_bkg_wri( kstp ) ! output background fields … … 335 336 CALL ssh_swp( kstp ) ! swap of sea surface height 336 337 IF( lk_vvl ) CALL dom_vvl_sf_swp( kstp ) ! swap of vertical scale factors 337 338 ! 339 IF( lrst_oce ) CALL rst_write( kstp ) ! write output ocean restart file 340 341 #if defined key_agrif 342 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 343 ! AGRIF 344 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 345 CALL Agrif_Integrate_ChildGrids( stp ) 346 347 IF ( Agrif_NbStepint().EQ.0 ) THEN 348 CALL Agrif_Update_Tra() ! Update active tracers 349 CALL Agrif_Update_Dyn() ! Update momentum 350 ENDIF 351 #endif 338 352 IF( ln_diahsb ) CALL dia_hsb( kstp ) ! - ML - global conservation diagnostics 339 353 IF( lk_diaobs ) CALL dia_obs( kstp ) ! obs-minus-model (assimilation) diagnostics (call after dynamics update) 340 354 341 355 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 342 ! Control and restarts356 ! Control 343 357 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 344 358 CALL stp_ctl( kstp, indic ) … … 352 366 IF( lwm.AND.numoni /= -1 ) CALL FLUSH ( numoni ) ! flush output namelist ice 353 367 ENDIF 354 IF( lrst_oce ) CALL rst_write ( kstp ) ! write output ocean restart file355 368 356 369 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 367 380 ! 368 381 IF( nn_timing == 1 .AND. kstp == nit000 ) CALL timing_reset 382 ! 369 383 ! 370 384 END SUBROUTINE stp -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
r5501 r6204 112 112 #if defined key_agrif 113 113 USE agrif_opa_sponge ! Momemtum and tracers sponges 114 USE agrif_opa_update ! Update (2-way nesting) 114 115 #endif 115 116 #if defined key_top -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/OPA_SRC/stpctl.F90
r3294 r6204 17 17 USE dom_oce ! ocean space and time domain variables 18 18 USE sol_oce ! ocean space and time domain variables 19 USE sbc_oce ! surface boundary conditions variables 19 20 USE in_out_manager ! I/O manager 20 21 USE lbclnk ! ocean lateral boundary conditions (or mpp link) … … 22 23 USE dynspg_oce ! pressure gradient schemes 23 24 USE c1d ! 1D vertical configuration 25 24 26 25 27 IMPLICIT NONE … … 52 54 INTEGER, INTENT( inout ) :: kindic ! indicator of solver convergence 53 55 !! 56 CHARACTER(len = 32) :: clfname ! time stepping output file name 54 57 INTEGER :: ji, jj, jk ! dummy loop indices 55 58 INTEGER :: ii, ij, ik ! temporary integers … … 63 66 WRITE(numout,*) 'stp_ctl : time-stepping control' 64 67 WRITE(numout,*) '~~~~~~~' 65 ! open time.step file 66 CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 68 ! open time.step file with special treatment for SAS 69 IF ( nn_components == jp_iam_sas ) THEN 70 clfname = 'time.step.sas' 71 ELSE 72 clfname = 'time.step' 73 ENDIF 74 CALL ctl_opn( numstp, TRIM(clfname), 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 67 75 ENDIF 68 76 -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90
r5510 r6204 521 521 #endif 522 522 ! 523 INTEGER :: ierr,ierr1,ierr2,ierr3,ierr4,ierr5,ierr6 523 INTEGER :: ierr,ierr1,ierr2,ierr3,ierr4,ierr5,ierr6,ierr7,ierr8 524 524 INTEGER :: jpm 525 525 !!---------------------------------------------------------------------- … … 545 545 ALLOCATE( tsb(jpi,jpj,1,jpm) , STAT=ierr5 ) 546 546 ALLOCATE( sshn(jpi,jpj) , STAT=ierr6 ) 547 ierr = ierr + ierr1 + ierr2 + ierr3 + ierr4 + ierr5 + ierr6 547 ALLOCATE( un(jpi,jpj,1) , STAT=ierr7 ) 548 ALLOCATE( vn(jpi,jpj,1) , STAT=ierr8 ) 549 ierr = ierr + ierr1 + ierr2 + ierr3 + ierr4 + ierr5 + ierr6 + ierr7 + ierr8 548 550 #endif 549 551 ! -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90
r5215 r6204 599 599 600 600 !!====================================================================== 601 END MODULE 601 END MODULE p2zbio -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsms.F90
r5215 r6204 84 84 85 85 !!====================================================================== 86 END MODULE 86 END MODULE p2zsms -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90
r5385 r6204 109 109 110 110 !!====================================================================== 111 END MODULE p4zbio 112 111 END MODULE p4zbio -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90
r5215 r6204 396 396 397 397 !!====================================================================== 398 END MODULE 398 END MODULE p4zche -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90
r5385 r6204 400 400 401 401 !!====================================================================== 402 END MODULE 402 END MODULE p4zflx -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90
r5385 r6204 81 81 82 82 !!====================================================================== 83 END MODULE 83 END MODULE p4zint -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90
r5385 r6204 265 265 266 266 !!====================================================================== 267 END MODULE 267 END MODULE p4zlim -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90
r5385 r6204 152 152 IF( iom_use( "DCAL" ) ) CALL iom_put( "DCAL" , zcaldiss(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ) 153 153 ELSE 154 trc3d(:,:,:,jp_pcs0_3d ) = -1. * LOG10( hi(:,:,:) ) * tmask(:,:,:) 155 trc3d(:,:,:,jp_pcs0_3d + 1) = zco3(:,:,:) * tmask(:,:,:) 156 trc3d(:,:,:,jp_pcs0_3d + 2) = aksp(:,:,:) / calcon * tmask(:,:,:) 154 IF( ln_diatrc ) THEN 155 trc3d(:,:,:,jp_pcs0_3d ) = -1. * LOG10( hi(:,:,:) ) * tmask(:,:,:) 156 trc3d(:,:,:,jp_pcs0_3d + 1) = zco3(:,:,:) * tmask(:,:,:) 157 trc3d(:,:,:,jp_pcs0_3d + 2) = aksp(:,:,:) / calcon * tmask(:,:,:) 158 ENDIF 157 159 ENDIF 158 160 ! … … 223 225 #endif 224 226 !!====================================================================== 225 END MODULE 227 END MODULE p4zlys -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90
r5385 r6204 340 340 341 341 !!====================================================================== 342 END MODULE 342 END MODULE p4zmeso -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90
r5385 r6204 273 273 274 274 !!====================================================================== 275 END MODULE 275 END MODULE p4zmicro -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90
r5385 r6204 277 277 278 278 !!====================================================================== 279 END MODULE 279 END MODULE p4zmort -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90
r5385 r6204 439 439 440 440 !!====================================================================== 441 END MODULE 441 END MODULE p4zopt -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90
r5385 r6204 629 629 630 630 !!====================================================================== 631 END MODULE 631 END MODULE p4zprod -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90
r5507 r6204 519 519 520 520 !!====================================================================== 521 END MODULE 521 END MODULE p4zsbc -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90
r5385 r6204 436 436 437 437 !!====================================================================== 438 END MODULE 438 END MODULE p4zsed -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90
r5385 r6204 913 913 914 914 !!====================================================================== 915 END MODULE 915 END MODULE p4zsink -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90
r5385 r6204 102 102 ENDIF 103 103 104 #if defined key_agrif 105 CALL Agrif_trc ! AGRIF zoom boundaries 106 #endif 104 107 ! Update after tracer on domain lateral boundaries 105 108 DO jn = 1, jptra … … 110 113 #if defined key_bdy 111 114 !! CALL bdy_trc( kt ) ! BDY open boundaries 112 #endif113 #if defined key_agrif114 CALL Agrif_trc ! AGRIF zoom boundaries115 115 #endif 116 116 -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/trcnam.F90
r5411 r6204 397 397 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 398 398 !!====================================================================== 399 END MODULE 399 END MODULE trcnam -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/trcsms.F90
r3680 r6204 75 75 76 76 !!====================================================================== 77 END MODULE 77 END MODULE trcsms -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
r5407 r6204 32 32 REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE :: qsr_arr ! save qsr during TOP time-step 33 33 REAL(wp) :: rdt_sampl 34 INTEGER :: nb_rec_per_day s34 INTEGER :: nb_rec_per_day 35 35 INTEGER :: isecfst, iseclast 36 36 LOGICAL :: llnew … … 123 123 !! of diurnal cycle 124 124 !! 125 !! ** Method : store in TOP the qsr every hour ( or every time-step the latter125 !! ** Method : store in TOP the qsr every hour ( or every time-step if the latter 126 126 !! is greater than 1 hour ) and then, compute the mean with 127 127 !! a moving average over 24 hours. … … 134 134 IF( ln_cpl ) THEN 135 135 rdt_sampl = 86400. / ncpl_qsr_freq 136 nb_rec_per_day s= ncpl_qsr_freq136 nb_rec_per_day = ncpl_qsr_freq 137 137 ELSE 138 138 rdt_sampl = MAX( 3600., rdt * nn_dttrc ) 139 nb_rec_per_day s= INT( 86400 / rdt_sampl )139 nb_rec_per_day = INT( 86400 / rdt_sampl ) 140 140 ENDIF 141 141 ! 142 142 IF( lwp ) THEN 143 143 WRITE(numout,*) 144 WRITE(numout,*) ' Sampling frequency dt = ', rdt_sampl, 's',' Number of sampling per day nrec = ', nb_rec_per_day s144 WRITE(numout,*) ' Sampling frequency dt = ', rdt_sampl, 's',' Number of sampling per day nrec = ', nb_rec_per_day 145 145 WRITE(numout,*) 146 146 ENDIF 147 147 ! 148 ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_days ) ) 149 DO jn = 1, nb_rec_per_days 150 qsr_arr(:,:,jn) = qsr(:,:) 148 ! !* Restart: read in restart file 149 IF( ln_rsttr .AND. iom_varid( numrtr, 'qsr_mean', ldstop = .FALSE. ) > 0 ) THEN 150 IF(lwp) WRITE(numout,*) 'trc_qsr_mean: qsr_mean read in the restart file' 151 CALL iom_get( numrtr, jpdom_autoglo, 'qsr_mean', qsr_mean ) ! A mean of qsr 152 ELSE !* no restart: set from nit000 values 153 IF(lwp) WRITE(numout,*) 'trc_qsr_mean: qsr_mean set to nit000 values' 154 qsr_mean(:,:) = qsr(:,:) 155 ENDIF 156 ! 157 ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_day ) ) 158 DO jn = 1, nb_rec_per_day 159 qsr_arr(:,:,jn) = qsr_mean(:,:) 151 160 ENDDO 152 qsr_mean(:,:) = qsr(:,:)153 161 ! 154 162 isecfst = nsec_year + nsec1jan000 ! number of seconds between Jan. 1st 00h of nit000 year and the middle of time step … … 163 171 & ' time = ', (iseclast+rdt*nn_dttrc/2.)/3600.,'hours ' 164 172 isecfst = iseclast 165 DO jn = 1, nb_rec_per_day s- 1173 DO jn = 1, nb_rec_per_day - 1 166 174 qsr_arr(:,:,jn) = qsr_arr(:,:,jn+1) 167 175 ENDDO 168 qsr_arr (:,:,nb_rec_per_days) = qsr(:,:) 169 qsr_mean(:,: ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_days 170 ENDIF 171 ! 176 qsr_arr (:,:,nb_rec_per_day) = qsr(:,:) 177 qsr_mean(:,: ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_day 178 ENDIF 179 ! 180 IF( lrst_trc ) THEN !* Write the mean of qsr in restart file 181 IF(lwp) WRITE(numout,*) 182 IF(lwp) WRITE(numout,*) 'trc_mean_qsr : write qsr_mean in restart file kt =', kt 183 IF(lwp) WRITE(numout,*) '~~~~~~~' 184 CALL iom_rstput( kt, nitrst, numrtw, 'qsr_mean', qsr_mean(:,:) ) 185 ENDIF 186 ! 172 187 END SUBROUTINE trc_mean_qsr 173 188 -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/SETTE/prepare_exe_dir.sh
r4773 r6204 70 70 export EXE_DIR=${CONFIG_DIR}/${NEW_CONF}/${TEST_NAME} 71 71 72 cp -r ${CONFIG_DIR}/${NEW_CONF}/EXP00/* ${EXE_DIR}/.72 cp -rL ${CONFIG_DIR}/${NEW_CONF}/EXP00/* ${EXE_DIR}/. 73 73 cp -r ${SETTE_DIR}/iodef_sette.xml ${EXE_DIR}/iodef.xml 74 74 cd ${EXE_DIR} -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/COMPILE/Fprep_agrif.sh
r3294 r6204 57 57 #- AGRIF conv 58 58 if [ "$AGRIFUSE" == 1 ]; then 59 #-MPI for AGRIF 60 if [ ! -f ${MAIN_DIR}/EXTERNAL/AGRIF/nemo_mpi.h ];then 61 echo '#if defined key_mpp_mpi' > ${MAIN_DIR}/EXTERNAL/AGRIF/nemo_mpi.h 62 echo '#define AGRIF_MPI' >> ${MAIN_DIR}/EXTERNAL/AGRIF/nemo_mpi.h 63 echo '#endif' >> ${MAIN_DIR}/EXTERNAL/AGRIF/nemo_mpi.h 64 fi 59 65 60 66 #- CONV 61 #fcm build ${TOOLS_DIR}/conv.cfg || exit 1 62 gmake -C ${MAIN_DIR}/EXTERNAL/AGRIF/LIB 67 fcm build ${COMPIL_DIR}/conv.cfg || exit 1 68 #C_COMPILER=${CC-cc} 69 #gmake CC=${C_COMPILER} -C ${MAIN_DIR}/EXTERNAL/AGRIF/LIB 63 70 64 71 #- AGRIF sources … … 67 74 [ ! -d $2/$1/OPAFILES/AGRIF_MODELFILES ] && mkdir $2/$1/OPAFILES/AGRIF_MODELFILES 68 75 cp -f -r ${MAIN_DIR}/EXTERNAL/AGRIF/agrif_opa.in $2/$1/OPAFILES/ 69 cp -f -r ${MAIN_DIR}/EXTERNAL/AGRIF/conv $2/$1/OPAFILES/ 76 #cp -f -r ${MAIN_DIR}/EXTERNAL/AGRIF/conv $2/$1/OPAFILES/ 77 cp -f -r $2/$1/AGRIFLIB/bin/conv $2/$1/OPAFILES/ 70 78 71 79 fi -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/COMPILE/bld.cfg
r4990 r6204 41 41 bld::tool::fppflags::nemo %FPPFLAGS -I$CONFIG_DIR/$NEW_CONF/OPAFILES/inc 42 42 bld::tool::fppflags::ioipsl %FPPFLAGS 43 bld::tool::fppflags::agrif %FPPFLAGS 43 bld::tool::fppflags::agrif %FPPFLAGS -include ${MAIN_DIR}/EXTERNAL/AGRIF/nemo_mpi.h 44 44 45 45 # Ignore the following dependencies -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/COMPILE/bld_preproagr.cfg
r4990 r6204 52 52 bld::excl_dep use::ioipsl 53 53 bld::excl_dep use::xios 54 bld::excl_dep use::agrif_grids 54 55 bld::excl_dep use::agrif_types 55 56 bld::excl_dep use::agrif_util -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/COMPILE/conv.cfg
r3294 r6204 8 8 # Build information 9 9 # ------------------------------------------------------------------------------ 10 inc $COMPIL_DIR/arch .fcm10 inc $COMPIL_DIR/arch_nemo.fcm 11 11 12 bld::tool::cc %CC 13 bld::tool::cflags %CFLAGS 12 14 bld::tool::make %MK 13 15 … … 19 21 dir::root $NEMO_TDIR/$NEW_CONF/AGRIFLIB 20 22 21 bld::tool::cflags::convsrc -O022 bld::tool::ld::convsrc cc23 bld::tool::ldflags::convsrc -O ../obj/fortran.o ../obj/fortran.o24 bld::pp 123 #bld::tool::cflags::convsrc -O0 24 #bld::tool::ld::convsrc cc 25 #bld::tool::ldflags::convsrc -O ../obj/fortran.o ../obj/fortran.o 26 #bld::pp 1 25 27 26 28 -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/NESTING/agulhas
r2455 r6204 17 17 removeclosedseas = true 18 18 type_bathy_interp = 0 19 rn_hmin = -3 19 20 / 20 21 … … 39 40 pa1 = 245.58132232490 40 41 N = 31 42 ldbletanh = .FALSE. 43 ppa2 = 0.0 44 ppkth2 = 0.0 45 ppacr2 = 0.0 41 46 / 42 47 … … 45 50 parent_bathy_meter = 'bathy_meter.nc' 46 51 parent_batmet_name = 'Bathymetry' 47 e3zps_min = 2 5.48 e3zps_rat = 0. 252 e3zps_min = 20. 53 e3zps_rat = 0.1 49 54 / 50 55 -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/NESTING/src/agrif_connect_topo.f90
r2143 r6204 105 105 IMPLICIT NONE 106 106 ! 107 REAL*8 :: za 1,za0,zsur,zacr,zkth,zmin,zmax107 REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zmin,zmax 108 108 TYPE(Coordinates) :: Grid 109 109 INTEGER :: i,j … … 134 134 za0 = pa0 135 135 za1 = pa1 136 za2 = pa2 136 137 ! 137 138 ELSE … … 147 148 148 149 zacr = ppacr 149 zkth = ppkth 150 150 zkth = ppkth 151 zacr2 = ppacr2 152 zkth2 = ppkth2 151 153 ! 152 154 ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N)) 153 155 ! 154 DO i = 1,N 155 gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 156 gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr))) 157 e3w(i) = (za0 + za1 * TANH((i-zkth)/zacr)) 158 e3t(i) = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 159 END DO 156 IF( ppkth == 0. ) THEN ! uniform vertical grid 157 za1 = pphmax / FLOAT(N-1) 158 DO i = 1, N 159 gdepw(i) = ( i - 1 ) * za1 160 gdept(i) = ( i - 0.5 ) * za1 161 e3w (i) = za1 162 e3t (i) = za1 163 END DO 164 ELSE ! Madec & Imbard 1996 function 165 IF( .NOT. ldbletanh ) THEN 166 DO i = 1,N 167 ! 168 gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 169 gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr))) 170 e3w(i) = (za0 + za1 * TANH((i-zkth)/zacr)) 171 e3t(i) = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 172 ! 173 END DO 174 ELSE 175 DO i = 1,N 176 ! Double tanh function 177 gdepw(i) = ( zsur + za0*i + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr ) ) & 178 & + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) ) ) 179 gdept(i) = ( zsur + za0*(i+0.5) + za1 * zacr * LOG ( COSH( ((i+0.5)-zkth ) / zacr ) ) & 180 & + za2 * zacr2* LOG ( COSH( ((i+0.5)-zkth2) / zacr2 ) ) ) 181 e3w (i) = za0 + za1 * TANH( (i-zkth ) / zacr ) & 182 & + za2 * TANH( (i-zkth2) / zacr2 ) 183 e3t (i) = za0 + za1 * TANH( ((i+0.5)-zkth ) / zacr ) & 184 & + za2 * TANH( ((i+0.5)-zkth2) / zacr2 ) 185 END DO 186 ENDIF 187 ENDIF 160 188 ! 161 189 gdepw(1) = 0.0 162 190 zmax = gdepw(N) + e3t(N) 163 zmin = gdepw(4) 191 IF( rn_hmin < 0. ) THEN ; i = - INT( rn_hmin ) ! from a nb of level 192 ELSE ; i = MINLOC( gdepw, mask = gdepw > rn_hmin, dim = 1 ) ! from a depth 193 ENDIF 194 zmin = gdepw(i+1) 164 195 ! 165 196 IF ( .NOT. ASSOCIATED(Grid%bathy_level)) & … … 227 258 IMPLICIT NONE 228 259 ! 229 REAL*8 :: za 1,za0,zsur,zacr,zkth,zmin,zmax260 REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zmin,zmax 230 261 TYPE(Coordinates) :: Grid 231 262 INTEGER :: i,j … … 257 288 za0 = pa0 258 289 za1 = pa1 290 za2 = pa2 259 291 ! 260 292 ELSE … … 264 296 WRITE(*,*) 'please check values of variables' 265 297 WRITE(*,*) 'in namelist vertical_grid section' 266 WRITE(*,*) ' ' 267 STOP 298 WRITE(*,*) ' ' 299 STOP 268 300 ! 269 301 ENDIF 270 ! 302 271 303 zacr = ppacr 272 zkth = ppkth 273 304 zkth = ppkth 305 zacr2 = ppacr2 306 zkth2 = ppkth2 274 307 ! 275 308 ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N)) 276 309 ! 277 DO i = 1,N 278 ! 279 gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 280 gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr))) 281 e3w(i) = (za0 + za1 * TANH((i-zkth)/zacr)) 282 e3t(i) = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 283 END DO 310 IF( ppkth == 0. ) THEN ! uniform vertical grid 311 za1 = pphmax / FLOAT(N-1) 312 DO i = 1, N 313 gdepw(i) = ( i - 1 ) * za1 314 gdept(i) = ( i - 0.5 ) * za1 315 e3w (i) = za1 316 e3t (i) = za1 317 END DO 318 ELSE ! Madec & Imbard 1996 function 319 IF( .NOT. ldbletanh ) THEN 320 DO i = 1,N 321 ! 322 gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 323 gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr))) 324 e3w(i) = (za0 + za1 * TANH((i-zkth)/zacr)) 325 e3t(i) = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 326 ! 327 END DO 328 ELSE 329 DO i = 1,N 330 ! Double tanh function 331 gdepw(i) = ( zsur + za0*i + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr ) ) & 332 & + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) ) ) 333 gdept(i) = ( zsur + za0*(i+0.5) + za1 * zacr * LOG ( COSH( ((i+0.5)-zkth ) / zacr ) ) & 334 & + za2 * zacr2* LOG ( COSH( ((i+0.5)-zkth2) / zacr2 ) ) ) 335 e3w (i) = za0 + za1 * TANH( (i-zkth ) / zacr ) & 336 & + za2 * TANH( (i-zkth2) / zacr2 ) 337 e3t (i) = za0 + za1 * TANH( ((i+0.5)-zkth ) / zacr ) & 338 & + za2 * TANH( ((i+0.5)-zkth2) / zacr2 ) 339 END DO 340 ENDIF 341 ENDIF 284 342 ! 285 343 gdepw(1) = 0.0 … … 684 742 ! for consistency with fine grid bathymetry * 685 743 ! * 686 ! if a given coarse grid point is masked and one of the 687 ! child grid points contained in this coarse cell is not masked 688 ! the corresponding coarse grid point is unmasked with gdepw(4)*689 ! value 744 ! if a given coarse grid point is masked and one of the * 745 ! child grid points contained in this coarse cell is not masked * 746 ! the corresponding coarse grid point is unmasked with rn_hmin * 747 ! value * 690 748 ! * 691 749 ! - input : * … … 704 762 ! 705 763 INTEGER :: ideb,jdeb,ifin,jfin 706 REAL*8 :: za 1,za0,zsur,zacr,zkth,zmin764 REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zmin 707 765 INTEGER :: i,j 708 766 INTEGER :: k1 … … 727 785 za0 = pa0 728 786 za1 = pa1 787 za2 = pa2 729 788 ! 730 789 ELSE … … 740 799 741 800 zacr = ppacr 742 zkth = ppkth 743 801 zkth = ppkth 802 zacr2 = ppacr2 803 zkth2 = ppkth2 744 804 ! 745 805 ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N)) 746 806 ! 747 DO i = 1,N 748 ! 749 gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 750 gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr))) 751 e3w(i) = (za0 + za1 * TANH((i-zkth)/zacr)) 752 e3t(i) = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 753 END DO 754 ! 755 zmin = gdepw(4) 807 IF( ppkth == 0. ) THEN ! uniform vertical grid 808 za1 = pphmax / FLOAT(N-1) 809 DO i = 1, N 810 gdepw(i) = ( i - 1 ) * za1 811 gdept(i) = ( i - 0.5 ) * za1 812 e3w (i) = za1 813 e3t (i) = za1 814 END DO 815 ELSE ! Madec & Imbard 1996 function 816 IF( .NOT. ldbletanh ) THEN 817 DO i = 1,N 818 ! 819 gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 820 gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr))) 821 e3w(i) = (za0 + za1 * TANH((i-zkth)/zacr)) 822 e3t(i) = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 823 ! 824 END DO 825 ELSE 826 DO i = 1,N 827 ! Double tanh function 828 gdepw(i) = ( zsur + za0*i + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr ) ) & 829 & + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) ) ) 830 gdept(i) = ( zsur + za0*(i+0.5) + za1 * zacr * LOG ( COSH( ((i+0.5)-zkth ) / zacr ) ) & 831 & + za2 * zacr2* LOG ( COSH( ((i+0.5)-zkth2) / zacr2 ) ) ) 832 e3w (i) = za0 + za1 * TANH( (i-zkth ) / zacr ) & 833 & + za2 * TANH( (i-zkth2) / zacr2 ) 834 e3t (i) = za0 + za1 * TANH( ((i+0.5)-zkth ) / zacr ) & 835 & + za2 * TANH( ((i+0.5)-zkth2) / zacr2 ) 836 END DO 837 ENDIF 838 ENDIF 839 ! 840 IF( rn_hmin < 0. ) THEN ; i = - INT( rn_hmin ) ! from a nb of level 841 ELSE ; i = MINLOC( gdepw, mask = gdepw > rn_hmin, dim = 1 ) ! from a depth 842 ENDIF 843 zmin = gdepw(i+1) 756 844 ! 757 845 diff = 0 -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/NESTING/src/agrif_partial_steps.f90
r2143 r6204 36 36 ! 37 37 TYPE(Coordinates) :: Grid 38 REAL*8 :: za 1,za0,zsur,zacr,zkth,zdepth,zdepwp,zmin,zmax,zdiff,ze3tp,ze3wp38 REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zdepth,zdepwp,zmin,zmax,zdiff,ze3tp,ze3wp 39 39 INTEGER :: i,j,jk,jj,ji,jpj,jpi,ik,ii,ipt,jpt 40 40 INTEGER, DIMENSION(1) :: k … … 76 76 za0 = pa0 77 77 za1 = pa1 78 za2 = pa2 78 79 ! 79 80 ELSE … … 88 89 ENDIF 89 90 90 zacr = ppacr 91 zkth = ppkth 92 ! 93 DO i = 1,N 94 ! 95 gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 96 gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr))) 97 e3w(i) = (za0 + za1 * TANH((i-zkth)/zacr)) 98 e3t(i) = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 99 ! 100 END DO 101 ! 102 91 zacr = ppacr 92 zkth = ppkth 93 zacr2 = ppacr2 94 zkth2 = ppkth2 95 ! 96 IF( ppkth == 0. ) THEN ! uniform vertical grid 97 za1 = pphmax / FLOAT(N-1) 98 DO i = 1, N 99 gdepw(i) = ( i - 1 ) * za1 100 gdept(i) = ( i - 0.5 ) * za1 101 e3w (i) = za1 102 e3t (i) = za1 103 END DO 104 ELSE ! Madec & Imbard 1996 function 105 IF( .NOT. ldbletanh ) THEN 106 DO i = 1,N 107 ! 108 gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 109 gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr))) 110 e3w(i) = (za0 + za1 * TANH((i-zkth)/zacr)) 111 e3t(i) = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 112 ! 113 END DO 114 ELSE 115 DO i = 1,N 116 ! Double tanh function 117 gdepw(i) = ( zsur + za0*i + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr ) ) & 118 & + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) ) ) 119 gdept(i) = ( zsur + za0*(i+0.5) + za1 * zacr * LOG ( COSH( ((i+0.5)-zkth ) / zacr ) ) & 120 & + za2 * zacr2* LOG ( COSH( ((i+0.5)-zkth2) / zacr2 ) ) ) 121 e3w (i) = za0 + za1 * TANH( (i-zkth ) / zacr ) & 122 & + za2 * TANH( (i-zkth2) / zacr2 ) 123 e3t (i) = za0 + za1 * TANH( ((i+0.5)-zkth ) / zacr ) & 124 & + za2 * TANH( ((i+0.5)-zkth2) / zacr2 ) 125 END DO 126 ENDIF 127 ENDIF 103 128 gdepw(1) = 0.0 104 129 ! … … 106 131 ! 107 132 zmax = gdepw(N) + e3t(N) 108 zmin = gdepw(4) 133 IF( rn_hmin < 0. ) THEN ; i = - INT( rn_hmin ) ! from a nb of level 134 ELSE ; i = MINLOC( gdepw, mask = gdepw > rn_hmin, dim = 1 ) ! from a depth 135 ENDIF 136 zmin = gdepw(i+1) 109 137 ! 110 138 ! Initialize bathy_level to the maximum ocean level available … … 235 263 INTEGER :: i,j,ji,ij,ii,jj,jpt,ipt 236 264 REAL,DIMENSION(N) :: gdepw,e3t 237 REAL :: za0,za1,z sur,zacr,zkth,zmin,zmax,zdepth265 REAL :: za0,za1,za2,zsur,zacr,zacr2,zkth,zkth2,zmin,zmax,zdepth 238 266 INTEGER :: kbathy,jk,diff 239 267 INTEGER :: bornex,borney,bornex2,borney2 240 ! 268 ! 241 269 IF ( ( pa0 == 0 .OR. pa1 == 0 .OR. psur == 0 ) & 242 270 .AND. ppdzmin.NE.0 .AND. pphmax.NE.0 ) THEN 243 271 ! 272 WRITE(*,*) 'psur,pa0,pa1 computed' 244 273 za1=( ppdzmin - pphmax / (N-1) ) & 245 274 / ( TANH((1-ppkth)/ppacr) - ppacr/(N-1) & … … 253 282 pa0.NE.0 .AND. pa1.NE.0 ) THEN 254 283 ! 284 WRITE(*,*) 'psur,pa0,pa1 given by namelist' 255 285 zsur = psur 256 286 za0 = pa0 257 287 za1 = pa1 288 za2 = pa2 258 289 ! 259 290 ELSE … … 263 294 WRITE(*,*) 'please check values of variables' 264 295 WRITE(*,*) 'in namelist vertical_grid section' 265 WRITE(*,*) ' ' 266 ! 267 ENDIF 268 ! 269 zacr = ppacr 270 zkth = ppkth 271 ! 272 DO i = 1,N 273 ! 274 gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 275 e3t(i) = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 276 END DO 277 ! 296 WRITE(*,*) ' ' 297 STOP 298 ! 299 ENDIF 300 301 zacr = ppacr 302 zkth = ppkth 303 zacr2 = ppacr2 304 zkth2 = ppkth2 305 ! 306 IF( ppkth == 0. ) THEN ! uniform vertical grid 307 za1 = pphmax / FLOAT(N-1) 308 DO i = 1, N 309 gdepw(i) = ( i - 1 ) * za1 310 e3t (i) = za1 311 END DO 312 ELSE ! Madec & Imbard 1996 function 313 IF( .NOT. ldbletanh ) THEN 314 DO i = 1,N 315 ! 316 gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 317 e3t(i) = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 318 ! 319 END DO 320 ELSE 321 DO i = 1,N 322 ! Double tanh function 323 gdepw(i) = ( zsur + za0*i + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr ) ) & 324 & + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) ) ) 325 e3t (i) = za0 + za1 * TANH( ((i+0.5)-zkth ) / zacr ) & 326 & + za2 * TANH( ((i+0.5)-zkth2) / zacr2 ) 327 END DO 328 ENDIF 329 ENDIF 278 330 gdepw(1) = 0.0 279 !280 331 ! 281 332 diff = 0 … … 344 395 ! 345 396 zmax = gdepw(N) + e3t(N) 346 zmin = gdepw(4) 397 IF( rn_hmin < 0. ) THEN ; i = - INT( rn_hmin ) ! from a nb of level 398 ELSE ; i = MINLOC( gdepw, mask = gdepw > rn_hmin, dim = 1 ) ! from a depth 399 ENDIF 400 zmin = gdepw(i+1) 347 401 ! 348 402 ! check that interpolated value stays at the same level … … 646 700 REAL*8, DIMENSION(:,:,:) :: fse3u,fse3t,fse3v 647 701 ! 648 REAL*8 :: za 1,za0,zsur,zacr,zkth,zdepth,zdepwp,zmin,zmax,zdiff,ze3tp,ze3wp702 REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zdepth,zdepwp,zmin,zmax,zdiff,ze3tp,ze3wp 649 703 INTEGER :: i,j,jk,jj,ji,jpj,jpi,ik,ii,ipt,jpt,jpk 650 704 INTEGER, DIMENSION(1) :: k … … 660 714 ALLOCATE(gdepw(jpk),e3t(jpk)) 661 715 ALLOCATE(gdepw_ps(jpi,jpj,jpk)) 662 ! 716 ! 663 717 IF ( ( pa0 == 0 .OR. pa1 == 0 .OR. psur == 0 ) & 664 718 .AND. ppdzmin.NE.0 .AND. pphmax.NE.0 ) THEN … … 668 722 / ( TANH((1-ppkth)/ppacr) - ppacr/(jpk-1) & 669 723 * ( LOG( COSH( (jpk - ppkth) / ppacr) ) & 670 - LOG( COSH( ( 1 - ppkth) / ppacr) ) ) ) 671 ! 724 - LOG( COSH( ( 1 - ppkth) / ppacr) ) ) ) 725 672 726 za0 = ppdzmin - za1 * TANH( (1-ppkth) / ppacr ) 673 727 zsur = - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr ) ) … … 676 730 pa0.NE.0 .AND. pa1.NE.0 ) THEN 677 731 ! 732 WRITE(*,*) 'psur,pa0,pa1 given by namelist' 678 733 zsur = psur 679 734 za0 = pa0 680 za1 = pa1 681 ! 682 ENDIF 683 684 zacr = ppacr 685 zkth = ppkth 735 za1 = pa1 736 za2 = pa2 737 ! 738 ELSE 739 ! 740 WRITE(*,*) 'ERROR ***** bad vertical grid parameters ...' 741 WRITE(*,*) ' ' 742 WRITE(*,*) 'please check values of variables' 743 WRITE(*,*) 'in namelist vertical_grid section' 744 WRITE(*,*) ' ' 745 STOP 746 ! 747 ENDIF 748 749 zacr = ppacr 750 zkth = ppkth 751 zacr2 = ppacr2 752 zkth2 = ppkth2 753 ! 754 IF( ppkth == 0. ) THEN ! uniform vertical grid 755 za1 = pphmax / FLOAT(jpk-1) 756 DO i = 1, jpk 757 gdepw(i) = ( i - 1 ) * za1 758 e3t (i) = za1 759 END DO 760 ELSE ! Madec & Imbard 1996 function 761 IF( .NOT. ldbletanh ) THEN 762 DO i = 1,jpk 763 ! 764 gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr))) 765 e3t(i) = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 766 ! 767 END DO 768 ELSE 769 DO i = 1,jpk 770 ! Double tanh function 771 gdepw(i) = ( zsur + za0*i + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr ) ) & 772 & + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) ) ) 773 e3t (i) = za0 + za1 * TANH( ((i+0.5)-zkth ) / zacr ) & 774 & + za2 * TANH( ((i+0.5)-zkth2) / zacr2 ) 775 END DO 776 ENDIF 777 ENDIF 686 778 ! 687 779 ! 688 780 DO i = 1,jpk 689 !690 gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr)))691 e3t(i) = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr))692 781 ! 693 782 fse3t(:,:,i) = e3t(i) … … 700 789 ! 701 790 zmax = gdepw(jpk) + e3t(jpk) 702 zmin = gdepw(4) 791 IF( rn_hmin < 0. ) THEN ; i = - INT( rn_hmin ) ! from a nb of level 792 ELSE ; i = MINLOC( gdepw, mask = gdepw > rn_hmin, dim = 1 ) ! from a depth 793 ENDIF 794 zmin = gdepw(i+1) 703 795 ! 704 796 DO jj = 1, jpj -
branches/2015/nemo_v3_6_STABLE/NEMOGCM/TOOLS/NESTING/src/agrif_types.f90
r2455 r6204 51 51 INTEGER jpizoom,jpjzoom,nb_connection_pts 52 52 ! 53 REAL*8 ppacr,ppdzmin,pphmax,ppkth,smoothing_factor,e3zps_min,e3zps_rat 54 REAL*8 psur,pa0,pa1,adatrj 53 REAL*8 rn_hmin 54 REAL*8 ppkth2, ppacr2, ppkth,ppacr,ppdzmin,pphmax,smoothing_factor,e3zps_min,e3zps_rat 55 REAL*8 psur,pa0,pa1,pa2,adatrj 55 56 ! 57 LOGICAL ldbletanh 56 58 LOGICAL partial_steps,smoothing,bathy_update 57 59 LOGICAL new_topo,removeclosedseas,dimg,iom_activated … … 70 72 ! 71 73 NAMELIST /bathymetry/new_topo,elevation_database,elevation_name,smoothing,smoothing_factor, & 72 nb_connection_pts,removeclosedseas,type_bathy_interp 74 nb_connection_pts,removeclosedseas,type_bathy_interp,rn_hmin 73 75 ! 74 76 NAMELIST /nesting/imin,imax,jmin,jmax,rho,rhot,bathy_update,updated_parent_file 75 77 ! 76 NAMELIST /vertical_grid/ppkth,ppacr,ppdzmin,pphmax,psur,pa0,pa1,N 78 NAMELIST /vertical_grid/ppkth,ppacr,ppdzmin,pphmax,psur,pa0,pa1,N,ldbletanh,ppa2,ppkth2,ppacr2 77 79 ! 78 80 NAMELIST /partial_cells/partial_steps,parent_bathy_meter,parent_batmet_name,e3zps_min,e3zps_rat
Note: See TracChangeset
for help on using the changeset viewer.