Changeset 8738 for branches/UKMO
- Timestamp:
- 2017-11-17T15:40:12+01:00 (6 years ago)
- Location:
- branches/UKMO/dev_r8183_ICEMODEL_svn_removed
- Files:
-
- 35 deleted
- 86 edited
- 38 copied
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/nambdy_dta
r8733 r8738 11 11 bn_tem = 'amm12_bdyT_tra', 24 , 'votemper', .true. , .false. , 'daily' , '' , '' , '' 12 12 bn_sal = 'amm12_bdyT_tra', 24 , 'vosaline', .true. , .false. , 'daily' , '' , '' , '' 13 ! for lim214 ! bn_frld = 'amm12_bdyT_ice', 24 , 'ileadfra', .true. , .false. , 'daily' , '' , '' , ''15 ! bn_hicif = 'amm12_bdyT_ice', 24 , 'iicethic', .true. , .false. , 'daily' , '' , '' , ''16 ! bn_hsnif = 'amm12_bdyT_ice', 24 , 'isnowthi', .true. , .false. , 'daily' , '' , '' , ''17 13 ! for lim3 18 14 ! bn_a_i = 'amm12_bdyT_ice', 24 , 'ileadfra', .true. , .false. , 'daily' , '' , '' , '' -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/Namelists/namsbc
r6997 r8738 23 23 ! = 2 Redistribute a single flux over categories (coupled mode only) 24 24 ! Sea-ice : 25 nn_ice = 2! =0 no ice boundary condition ,25 nn_ice = 3 ! =0 no ice boundary condition , 26 26 ! =1 use observed ice-cover , 27 ! = 2 ice-model used ("key_lim3", "key_lim2", "key_cice")27 ! =3-4 ice-model used ("key_lim3", "key_cice") 28 28 nn_ice_embd = 1 ! =0 levitating ice (no mass exchange, concentration/dilution effect) 29 29 ! =1 levitating ice with mass and salt exchange but no presure effect -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/DOC/TexFiles/Chapters/Chap_SBC.tex
r7646 r8738 1266 1266 ice-ocean fluxes, that are combined with the air-sea fluxes using the ice fraction of 1267 1267 each model cell to provide the surface ocean fluxes. Note that the activation of a 1268 sea-ice model is is done by defining a CPP key (\key{lim 2}, \key{lim3} or \key{cice}).1268 sea-ice model is is done by defining a CPP key (\key{lim3} or \key{cice}). 1269 1269 The activation automatically overwrites the read value of nn{\_}ice to its appropriate 1270 1270 value ($i.e.$ $2$ for LIM-2, $3$ for LIM-3 or $4$ for CICE). -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/1_namelist_cfg
r7942 r8738 20 20 / 21 21 !----------------------------------------------------------------------- 22 &namzgr ! vertical coordinate23 !-----------------------------------------------------------------------24 ln_zps = .true. ! z-coordinate - partial steps25 /26 !-----------------------------------------------------------------------27 22 &namdom ! space and time domain (bathymetry, mesh, timestep) 28 23 !----------------------------------------------------------------------- 29 ln_linssh = . true. ! =T linear free surface ==>> model level are fixed in time24 ln_linssh = .false. ! =T linear free surface ==>> model level are fixed in time 30 25 nn_closea = 0 ! remove (=0) or keep (=1) closed seas and lakes (ORCA) 31 26 ! … … 46 41 !----------------------------------------------------------------------- 47 42 ln_blk = .true. ! CORE bulk formulation (T => fill namsbc_core) 48 nn_ice = 3! =0 no ice boundary condition ,43 nn_ice = 2 ! =0 no ice boundary condition , 49 44 ! =1 use observed ice-cover , 50 ! =2 ice-model used ("key_lim3" or "key_lim2)45 ! =2 ice-model used ("key_lim3") 51 46 ln_rnf = .false. ! runoffs (T => fill namsbc_rnf) 52 47 ln_ssr = .false. ! Sea Surface Restoring on T and/or S (T => fill namsbc_ssr) … … 176 171 &namdyn_hpg ! Hydrostatic pressure gradient option 177 172 !----------------------------------------------------------------------- 173 ln_hpg_sco = .true. ! s-coordinate (standard jacobian formulation) 178 174 / 179 175 !----------------------------------------------------------------------- -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/file_def_nemo.xml
r7948 r8738 95 95 <field field_ref="avt" name="difvho" /> 96 96 <field field_ref="w_masstr" name="vovematr" /> 97 98 99 100 101 102 103 97 <!-- variables available with key_zdftmx_new --> 98 <field field_ref="av_wave" name="av_wave" /> 99 <field field_ref="bn2" name="bn2" /> 100 <field field_ref="bflx_tmx" name="bflx_tmx" /> 101 <field field_ref="pcmap_tmx" name="pcmap_tmx" /> 102 <field field_ref="emix_tmx" name="emix_tmx" /> 103 <field field_ref="av_ratio" name="av_ratio" /> 104 104 </file> 105 105 -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_cfg
r7933 r8738 17 17 ! ! (=F) user defined configuration ==>>> see usrdef(_...) modules 18 18 cn_domcfg = "ORCA_R2_zps_domcfg" ! domain configuration filename 19 /20 !-----------------------------------------------------------------------21 &namzgr ! vertical coordinate22 !-----------------------------------------------------------------------23 ln_zps = .true. ! z-coordinate - partial steps24 19 / 25 20 !----------------------------------------------------------------------- -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_LIM3_PISCES/EXP00/namelist_ice_cfg
r7823 r8738 1 1 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 2 !! LIM3 configuration namelist: Overwrites SHARED/namelist_ice_lim3_ref 3 !! 1 - Generic parameters (namicerun) 4 !! 2 - Diagnostics (namicediag) 5 !! 3 - Ice initialization (namiceini) 6 !! 4 - Ice discretization (namiceitd) 7 !! 5 - Ice dynamics and transport (namicedyn) 8 !! 6 - Ice diffusion (namicehdf) 9 !! 7 - Ice thermodynamics (namicethd) 10 !! 8 - Ice salinity (namicesal) 11 !! 9 - Ice mechanical redistribution (namiceitdme) 12 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 2 !! ESIM configuration namelist: Overwrites SHARED/namelist_ice_lim3_ref 3 !! 1 - Generic parameters (nampar) 4 !! 2 - Ice thickness discretization (namitd) 5 !! 3 - Ice dynamics (namdyn) 6 !! 4 - Ice ridging/rafting (namdyn_rdgrft) 7 !! 5 - Ice rheology (namdyn_rhg) 8 !! 6 - Ice advection (namdyn_adv) 9 !! 7 - Ice surface forcing (namforcing) 10 !! 8 - Ice thermodynamics (namthd) 11 !! 9 - Ice heat diffusion (namthd_zdf) 12 !! 10 - Ice lateral melting (namthd_da) 13 !! 11 - Ice growth in open water (namthd_do) 14 !! 12 - Ice salinity (namthd_sal) 15 !! 13 - Ice melt ponds (nammp) 16 !! 14 - Ice initialization (namini) 17 !! 15 - Ice/snow albedos (namalb) 18 !! 16 - Ice diagnostics (namdia) 19 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 20 ! 13 21 !------------------------------------------------------------------------------ 14 &nam icerun! Generic parameters22 &nampar ! Generic parameters 15 23 !------------------------------------------------------------------------------ 16 24 / 17 25 !------------------------------------------------------------------------------ 18 &nami cediag ! Diagnostics26 &namitd ! Ice discretization 19 27 !------------------------------------------------------------------------------ 20 28 / 21 29 !------------------------------------------------------------------------------ 22 &nam iceini ! Ice initialization30 &namdyn ! Ice dynamics 23 31 !------------------------------------------------------------------------------ 24 32 / 25 33 !------------------------------------------------------------------------------ 26 &nam iceitd ! Ice discretization34 &namdyn_rdgrft ! Ice ridging/rafting 27 35 !------------------------------------------------------------------------------ 28 36 / 29 37 !------------------------------------------------------------------------------ 30 &nam icedyn ! Ice dynamics and transport38 &namdyn_rhg ! Ice rheology 31 39 !------------------------------------------------------------------------------ 32 40 / 33 41 !------------------------------------------------------------------------------ 34 &nam icehdf ! Ice horizontal diffusion42 &namdyn_adv ! Ice advection 35 43 !------------------------------------------------------------------------------ 36 44 / 37 45 !------------------------------------------------------------------------------ 38 &nam icethd ! Ice thermodynamics46 &namforcing ! Ice surface forcing 39 47 !------------------------------------------------------------------------------ 40 48 / 41 49 !------------------------------------------------------------------------------ 42 &nam icesal ! Ice salinity50 &namthd ! Ice thermodynamics 43 51 !------------------------------------------------------------------------------ 44 52 / 45 53 !------------------------------------------------------------------------------ 46 &nam iceitdme ! Ice mechanical redistribution (ridging and rafting)54 &namthd_zdf ! Ice heat diffusion 47 55 !------------------------------------------------------------------------------ 48 56 / 57 !------------------------------------------------------------------------------ 58 &namthd_da ! Ice lateral melting 59 !------------------------------------------------------------------------------ 60 / 61 !------------------------------------------------------------------------------ 62 &namthd_do ! Ice growth in open water 63 !------------------------------------------------------------------------------ 64 / 65 !------------------------------------------------------------------------------ 66 &namthd_sal ! Ice salinity 67 !------------------------------------------------------------------------------ 68 / 69 !------------------------------------------------------------------------------ 70 &nammp ! Melt ponds 71 !------------------------------------------------------------------------------ 72 / 73 !------------------------------------------------------------------------------ 74 &namini ! Ice initialization 75 !------------------------------------------------------------------------------ 76 / 77 !------------------------------------------------------------------------------ 78 &namalb ! albedo parameters 79 !------------------------------------------------------------------------------ 80 / 81 !------------------------------------------------------------------------------ 82 &namdia ! Diagnostics 83 !------------------------------------------------------------------------------ 84 / -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/file_def_nemo.xml
r7635 r8738 21 21 --> 22 22 23 <file_definition type=" multiple_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="10d" min_digits="4">23 <file_definition type="one_file" name="@expname@_@freq@_@startdate@_@enddate@" sync_freq="10d" min_digits="4"> 24 24 25 <file_group id=" 1ts" output_freq="1ts" output_level="10" enabled=".TRUE."/> <!-- 1 time step files -->25 <file_group id="2ts" output_freq="2ts" output_level="10" enabled=".TRUE."/> <!-- 1 time step files --> 26 26 27 27 <file_group id="1h" output_freq="1h" output_level="10" enabled=".TRUE."/> <!-- 1h files --> … … 39 39 <file_group id="3d" output_freq="3d" output_level="10" enabled=".TRUE."/> <!-- 3d files --> 40 40 41 <file_group id=" 5d" output_freq="5d" output_level="10" enabled=".TRUE."> <!-- 5d files -->41 <file_group id="1ts" output_freq="1ts" output_level="10" enabled=".TRUE."> <!-- 5d files --> 42 42 43 43 <file id="file1" name_suffix="_grid_T" description="ocean T grid variables" > … … 110 110 111 111 <file id="file6" name_suffix="_icemod" description="ice variables" enabled=".true." > 112 <field field_ref="snowthic_cea" name="snthic" />113 <field field_ref="icethic_cea" name="sithic" />114 112 <field field_ref="icevolu" name="sivolu" /> 115 <field field_ref="snowvol" name="snvolu" />116 <field field_ref="iceconc" name="siconc" />117 118 <field field_ref="vfxbog" name="vfxbog" />119 <field field_ref="vfxdyn" name="vfxdyn" />120 <field field_ref="vfxopw" name="vfxopw" />121 <field field_ref="vfxsni" name="vfxsni" />122 <field field_ref="vfxsum" name="vfxsum" />123 <field field_ref="vfxbom" name="vfxbom" />124 <field field_ref="vfxres" name="vfxres" />125 <field field_ref="vfxice" name="vfxice" />126 <field field_ref="vfxsnw" name="vfxsnw" />127 <field field_ref="vfxsub" name="vfxsub" />128 <field field_ref="vfxspr" name="vfxspr" />129 130 <field field_ref="icetrp" name="sivtrp" />131 <field field_ref="snwtrp" name="snvtrp" />132 <field field_ref="saltrp" name="saltrp" />133 <field field_ref="deitrp" name="deitrp" />134 <field field_ref="destrp" name="destrp" />135 136 <field field_ref="sfxbri" name="sfxbri" />137 <field field_ref="sfxdyn" name="sfxdyn" />138 <field field_ref="sfxres" name="sfxres" />139 <field field_ref="sfxbog" name="sfxbog" />140 <field field_ref="sfxbom" name="sfxbom" />141 <field field_ref="sfxsum" name="sfxsum" />142 <field field_ref="sfxsni" name="sfxsni" />143 <field field_ref="sfxopw" name="sfxopw" />144 <field field_ref="sfx" name="sfx" />145 146 <field field_ref="hfxsum" name="hfxsum" />147 <field field_ref="hfxbom" name="hfxbom" />148 <field field_ref="hfxbog" name="hfxbog" />149 <field field_ref="hfxdif" name="hfxdif" />150 <field field_ref="hfxopw" name="hfxopw" />151 <field field_ref="hfxout" name="hfxout" />152 <field field_ref="hfxin" name="hfxin" />153 <field field_ref="hfxsnw" name="hfxsnw" />154 <field field_ref="hfxerr" name="hfxerr" />155 <field field_ref="hfxerr_rem" name="hfxerr_rem" />156 157 <!-- ice-ocean heat flux from mass exchange -->158 <field field_ref="hfxdyn" name="hfxdyn" />159 <field field_ref="hfxres" name="hfxres" />160 <field field_ref="hfxthd" name="hfxthd" />161 <!-- ice-atm. heat flux from mass exchange -->162 <field field_ref="hfxsub" name="hfxsub" />163 <field field_ref="hfxspr" name="hfxspr" />164 165 <!-- diags -->166 <field field_ref="hfxdhc" name="hfxdhc" />167 <field field_ref="hfxtur" name="hfxtur" />168 169 <field field_ref="isst" name="sst" />170 <field field_ref="isss" name="sss" />171 <field field_ref="micesalt" name="sisali" />172 <field field_ref="micet" name="sitemp" />173 <field field_ref="icest" name="sistem" />174 <field field_ref="icehc" name="siheco" />175 <field field_ref="isnowhc" name="snheco" />176 <field field_ref="miceage" name="siages" />177 178 <field field_ref="uice_ipa" name="sivelu" />179 <field field_ref="vice_ipa" name="sivelv" />180 <field field_ref="icevel" name="sivelo" />181 <field field_ref="idive" name="sidive" />182 <field field_ref="ishear" name="sishea" />183 <field field_ref="icestr" name="sistre" />184 185 <field field_ref="ibrinv" name="sibrin" />186 <field field_ref="icecolf" name="sicolf" />187 188 <field field_ref="iceage_cat" name="siagecat" />189 <field field_ref="iceconc_cat" name="siconcat" />190 <field field_ref="icethic_cat" name="sithicat" />191 <field field_ref="snowthic_cat" name="snthicat" />192 <field field_ref="salinity_cat" name="salincat" />193 <field field_ref="brinevol_cat" name="sibricat" />194 <field field_ref="icetemp_cat" name="sitemcat" />195 <field field_ref="snwtemp_cat" name="sntemcat" />196 113 197 114 </file> 198 199 <file id="file7" name_suffix="_scalar" description="scalar variables" enabled=".true." >200 <field field_ref="voltot" name="scvoltot" />201 <field field_ref="sshtot" name="scsshtot" />202 <field field_ref="sshsteric" name="scsshste" />203 <field field_ref="sshthster" name="scsshtst" />204 <field field_ref="masstot" name="scmastot" />205 <field field_ref="temptot" name="sctemtot" />206 <field field_ref="saltot" name="scsaltot" />207 208 <field field_ref="bgtemper" name="bgtemper" />209 <field field_ref="bgsaline" name="bgsaline" />210 <field field_ref="bgheatco" name="bgheatco" />211 <field field_ref="bgsaltco" name="bgsaltco" />212 <field field_ref="bgvolssh" name="bgvolssh" />213 <field field_ref="bgvole3t" name="bgvole3t" />214 <field field_ref="bgfrcvol" name="bgfrcvol" />215 <field field_ref="bgfrctem" name="bgfrctem" />216 <field field_ref="bgfrcsal" name="bgfrcsal" />217 218 <field field_ref="ibgvoltot" name="ibgvoltot" />219 <field field_ref="sbgvoltot" name="sbgvoltot" />220 <field field_ref="ibgarea" name="ibgarea" />221 <field field_ref="ibgsaline" name="ibgsaline" />222 <field field_ref="ibgtemper" name="ibgtemper" />223 <field field_ref="ibgheatco" name="ibgheatco" />224 <field field_ref="sbgheatco" name="sbgheatco" />225 <field field_ref="ibgsaltco" name="ibgsaltco" />226 227 <field field_ref="ibgvfx" name="ibgvfx" />228 <field field_ref="ibgvfxbog" name="ibgvfxbog" />229 <field field_ref="ibgvfxopw" name="ibgvfxopw" />230 <field field_ref="ibgvfxsni" name="ibgvfxsni" />231 <field field_ref="ibgvfxdyn" name="ibgvfxdyn" />232 <field field_ref="ibgvfxbom" name="ibgvfxbom" />233 <field field_ref="ibgvfxsum" name="ibgvfxsum" />234 <field field_ref="ibgvfxres" name="ibgvfxres" />235 <field field_ref="ibgvfxspr" name="ibgvfxspr" />236 <field field_ref="ibgvfxsnw" name="ibgvfxsnw" />237 <field field_ref="ibgvfxsub" name="ibgvfxsub" />238 239 <field field_ref="ibgsfx" name="ibgsfx" />240 <field field_ref="ibgsfxbri" name="ibgsfxbri" />241 <field field_ref="ibgsfxdyn" name="ibgsfxdyn" />242 <field field_ref="ibgsfxres" name="ibgsfxres" />243 <field field_ref="ibgsfxbog" name="ibgsfxbog" />244 <field field_ref="ibgsfxopw" name="ibgsfxopw" />245 <field field_ref="ibgsfxsni" name="ibgsfxsni" />246 <field field_ref="ibgsfxbom" name="ibgsfxbom" />247 <field field_ref="ibgsfxsum" name="ibgsfxsum" />248 249 <field field_ref="ibghfxdhc" name="ibghfxdhc" />250 <field field_ref="ibghfxspr" name="ibghfxspr" />251 252 <field field_ref="ibghfxres" name="ibghfxres" />253 <field field_ref="ibghfxsub" name="ibghfxsub" />254 <field field_ref="ibghfxdyn" name="ibghfxdyn" />255 <field field_ref="ibghfxthd" name="ibghfxthd" />256 <field field_ref="ibghfxsum" name="ibghfxsum" />257 <field field_ref="ibghfxbom" name="ibghfxbom" />258 <field field_ref="ibghfxbog" name="ibghfxbog" />259 <field field_ref="ibghfxdif" name="ibghfxdif" />260 <field field_ref="ibghfxopw" name="ibghfxopw" />261 <field field_ref="ibghfxout" name="ibghfxout" />262 <field field_ref="ibghfxin" name="ibghfxin" />263 <field field_ref="ibghfxsnw" name="ibghfxsnw" />264 265 <field field_ref="ibgfrcvol" name="ibgfrcvol" />266 <field field_ref="ibgfrcsfx" name="ibgfrcsfx" />267 <field field_ref="ibgvolgrm" name="ibgvolgrm" />268 269 </file>270 115 271 116 <!-- -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/namelist_cfg
r7404 r8738 19 19 / 20 20 !----------------------------------------------------------------------- 21 &namzgr ! vertical coordinate22 !-----------------------------------------------------------------------23 ln_zps = .true. ! z-coordinate - partial steps24 /25 !-----------------------------------------------------------------------26 21 &namdom ! space and time domain (bathymetry, mesh, timestep) 27 22 !----------------------------------------------------------------------- … … 81 76 &nambbc ! bottom temperature boundary condition (default: NO) 82 77 !----------------------------------------------------------------------- 83 ln_trabbc = .true. ! Apply a geothermal heating at the ocean bottom84 78 / 85 79 !----------------------------------------------------------------------- -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/EXP00/namelist_ice_cfg
r7404 r8738 1 1 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 2 !! LIM3 configuration namelist: Overwrites SHARED/namelist_ice_lim3_ref 3 !! 1 - Generic parameters (namicerun) 4 !! 2 - Diagnostics (namicediag) 5 !! 3 - Ice initialization (namiceini) 6 !! 4 - Ice discretization (namiceitd) 7 !! 5 - Ice dynamics and transport (namicedyn) 8 !! 6 - Ice diffusion (namicehdf) 9 !! 7 - Ice thermodynamics (namicethd) 10 !! 8 - Ice salinity (namicesal) 11 !! 9 - Ice mechanical redistribution (namiceitdme) 12 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 2 !! ESIM configuration namelist: Overwrites SHARED/namelist_ice_lim3_ref 3 !! 1 - Generic parameters (namice_run) 4 !! 2 - Ice thickness discretization (namice_itd) 5 !! 3 - Ice dynamics (namice_dyn) 6 !! 4 - Ice ridging/rafting (namice_rdgrft) 7 !! 5 - Ice rheology (namice_rhg) 8 !! 6 - Ice advection (namice_adv) 9 !! 7 - Ice thermodynamics (namice_thd) 10 !! 8 - Ice salinity (namice_sal) 11 !! 9 - Ice melt ponds (namice_mp) 12 !! 10 - Ice initialization (namice_ini) 13 !! 11 - Ice/snow albedos (namice_alb) 14 !! 12 - Ice diagnostics (namice_dia) 15 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 16 ! 13 17 !------------------------------------------------------------------------------ 14 &namice run ! Generic parameters18 &namice_run ! Generic parameters 15 19 !------------------------------------------------------------------------------ 16 20 / 17 21 !------------------------------------------------------------------------------ 18 &namice diag ! Diagnostics22 &namice_itd ! Ice discretization 19 23 !------------------------------------------------------------------------------ 20 24 / 21 25 !------------------------------------------------------------------------------ 22 &namice ini ! Ice initialization26 &namice_dyn ! Ice dynamics 23 27 !------------------------------------------------------------------------------ 24 28 / 25 29 !------------------------------------------------------------------------------ 26 &namice itd ! Ice discretization30 &namice_rdgrft ! Ice ridging/rafting 27 31 !------------------------------------------------------------------------------ 28 32 / 29 33 !------------------------------------------------------------------------------ 30 &namice dyn ! Ice dynamics and transport34 &namice_rhg ! Ice rheology 31 35 !------------------------------------------------------------------------------ 32 36 / 33 37 !------------------------------------------------------------------------------ 34 &namice hdf ! Ice horizontal diffusion38 &namice_adv ! Ice advection 35 39 !------------------------------------------------------------------------------ 36 40 / 37 41 !------------------------------------------------------------------------------ 38 &namice thd ! Ice thermodynamics42 &namice_thd ! Ice thermodynamics 39 43 !------------------------------------------------------------------------------ 40 44 / 41 45 !------------------------------------------------------------------------------ 42 &namice sal ! Ice salinity46 &namice_sal ! Ice salinity 43 47 !------------------------------------------------------------------------------ 44 48 / 45 49 !------------------------------------------------------------------------------ 46 &namice itdme ! Ice mechanical redistribution (ridging and rafting)50 &namicemp ! Melt ponds 47 51 !------------------------------------------------------------------------------ 48 52 / 53 !------------------------------------------------------------------------------ 54 &namice_ini ! Ice initialization 55 !------------------------------------------------------------------------------ 56 / 57 !------------------------------------------------------------------------------ 58 &namice_alb ! albedo parameters 59 !------------------------------------------------------------------------------ 60 / 61 !------------------------------------------------------------------------------ 62 &namice_dia ! Diagnostics 63 !------------------------------------------------------------------------------ 64 / -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/ORCA2_SAS_LIM3/cpp_ORCA2_SAS_LIM3.fcm
r7423 r8738 1 bld::tool::fppkeys key_ trabbl key_lim3 key_zdftke key_zdfddm key_zdftmxkey_iomput key_mpp_mpi1 bld::tool::fppkeys key_lim3 key_iomput key_mpp_mpi -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/field_def_nemo-lim.xml
r7767 r8738 12 12 <field_group id="SBC" grid_ref="grid_T_2D" > <!-- time step automaticaly defined based on nn_fsbc --> 13 13 14 <!-- LIM2(only) fields --> 15 <field id="qsr_ai_cea" long_name="Air-Ice downward solar heat flux (cell average)" standard_name="surface_downwelling_shortwave_flux_in_air" unit="W/m2" /> 16 <field id="qns_ai_cea" long_name="Air-Ice downward non-solar heat flux (cell average)" unit="W/m2" /> 17 <field id="qla_ai_cea" long_name="Air-Ice downward Latent heat flux (cell average)" standard_name="surface_downward_latent_heat_flux" unit="W/m2" /> 18 <field id="qsr_io_cea" long_name="Ice-Oce downward solar heat flux (cell average)" standard_name="net_downward_shortwave_flux_at_sea_water_surface" unit="W/m2" /> 19 <field id="qns_io_cea" long_name="Ice-Oce downward non-solar heat flux (cell average)" unit="W/m2" /> 20 <field id="iceprod_cea" long_name="Ice production (cell average)" unit="m/s" /> 21 <field id="iiceconc" long_name="Ice concentration" standard_name="sea_ice_area_fraction" unit="1" /> 22 <field id="ice_pres" long_name="Ice presence" unit="" /> 23 <field id="ist_cea" long_name="Ice surface temperature (cell average)" standard_name="surface_temperature" unit="degC" /> 24 <field id="ist_ipa" long_name="Ice surface temperature (ice presence average)" standard_name="surface_temperature" unit="degC" /> 25 <field id="u_imasstr" long_name="Sea-ice mass transport along i-axis" standard_name="sea_ice_x_transport" unit="kg/s" /> 26 <field id="v_imasstr" long_name="Sea-ice mass transport along j-axis" standard_name="sea_ice_y_transport" unit="kg/s" /> 14 <!-- SIMIP LIM fields --> 15 <field id="icethick" long_name="Sea-ice thickness per area" standard_name="sea_ice_thickness" unit="m" /> 16 <field id="icethic" long_name="Sea-ice thickness" standard_name="sea_ice_thickness" unit="m" /> 17 <field id="uice_mv" long_name="X-component of sea ice velocity" standard_name="sea_ice_x_velocity" unit="m/s" /> 18 <field id="vice_mv" long_name="Y-component of sea ice velocity" standard_name="sea_ice_y_velocity" unit="m/s" /> 19 <field id="icevel_mv" long_name="Sea-ice speed" standard_name="sea_ice_speed" unit="m/s" /> 20 <field id="icepres" long_name="Fraction of time steps with sea ice" standard_name="sea_ice_time_fraction" unit="" /> 21 <field id="iceconc" long_name="Sea-ice area fraction" standard_name="sea_ice_area_fraction" unit="" /> 22 <field id="iceconc_pct" long_name="Sea-ice area fraction in percent" standard_name="sea_ice_area_fraction_in_percent" unit="%" > iceconc * 100. </field > 23 <field id="icemass" long_name="Sea-ice mass per area" standard_name="sea_ice_amount" unit="kg/m2" /> 24 <field id="icevolu" long_name="Sea-ice volume per area" standard_name="sea_ice_thickness" unit="m" /> 25 <field id="snomass" long_name="Snow mass per area" standard_name="liquid_water_content_of_surface_snow" unit="kg/m2" /> 26 <field id="snothic" long_name="Snow thickness" standard_name="surface_snow_thickness" unit="m" /> 27 28 <field id="iceconc_cat_mv" long_name="Sea-ice area fractions in thickness categories" standard_name="sea_ice_area_fraction_over_categories" unit="" grid_ref="grid_T_3D_ncatice" /> 29 <field id="iceconc_cat_pct_mv" long_name="Sea-ice area fractions in thickness categories" standard_name="sea_ice_area_fraction_over_categories" unit="%" grid_ref="grid_T_3D_ncatice" > iceconc_cat_mv * 100. </field > 30 <field id="icethic_cat_mv" long_name="Sea-ice thickness in thickness categories" standard_name="sea_ice_thickness_over_categories" unit="m" grid_ref="grid_T_3D_ncatice" /> 31 <field id="snowthic_cat_mv" long_name="Snow thickness in thickness categories" standard_name="snow_thickness_over_categories" unit="m" grid_ref="grid_T_3D_ncatice" /> 32 33 <field id="icestK" long_name="Surface temperature of sea ice" standard_name="sea_ice_surface_temperature" unit="K" /> 34 <field id="icesntK" long_name="Temperature at snow-ice interface" standard_name="sea_ice_snow_interface_temperature" unit="K" /> 35 <field id="icebotK" long_name="Temperature at ice-ocean interface" standard_name="sea_ice_bottom_temperature" unit="K" /> 36 37 <field id="iceage" long_name="Age of sea ice" standard_name="age_of_sea_ice" unit="s" /> 38 <field id="icealb" long_name="Sea-ice or snow albedo" standard_name="sea_ice_albedo" unit="" /> 39 <field id="icesmass" long_name="Mass of salt in sea ice per area" standard_name="sea_ice_salt_mass" unit="kg/m2" /> 40 <field id="icesal" long_name="Sea ice salinity" standard_name="sea_ice_salinity" unit="g/kg" /> 41 <field id="icefb" long_name="Sea-ice freeboard" standard_name="sea_ice_freeboard" unit="m" /> 42 43 <field id="icehcneg" long_name="Sea-ice heat content per unit area" standard_name="integral_of_sea_ice_temperature_wrt_depth_expressed_as_heat_content" unit="J/m2" > (-1.0)*icehc </field> 44 <field id="isnhcneg" long_name="Snow-heat content per unit area" standard_name="thermal_energy_content_of_surface_snow" unit="J/m2" > </field> 45 46 <field id="wfxsum" long_name="Freshwater flux from sea-ice surface" standard_name="freshwater_flux_from_ice_surface" unit="kg/m2/s" /> 47 48 <field id="afxthd" long_name="sea-ice area fraction change from thermodynamics" standard_name="tendency_of_sea_ice_area_fraction_due_to_dynamics" unit="s-1" /> 49 <field id="afxdyn" long_name="sea-ice area fraction change from dynamics" standard_name="tendency_of_sea_ice_area_fraction_due_to_dynamics" unit="s-1" /> 50 51 <field id="dmithd" long_name="sea-ice mass change from thermodynamics" standard_name="tendency_of_sea_ice_amount_due_to_thermodynamics" unit="kg/m2/s" /> 52 <field id="dmidyn" long_name="sea-ice mass change from dynamics" standard_name="tendency_of_sea_ice_amount_due_to_dynamics" unit="kg/m2/s" /> 53 <field id="dmiopw" long_name="sea-ice mass change through growth in supercooled open water (aka frazil)" standard_name="tendency_of_sea_ice_amount_due_to_freezing_in_open_water" unit="kg/m2/s" /> 54 <field id="dmibog" long_name="sea-ice mass change through basal growth" standard_name="tendency_of_sea_ice_amount_due_to_congelation_ice_accumulation" unit="kg/m2/s" /> 55 <field id="dmisni" long_name="sea-ice mass change through snow-to-ice conversion" standard_name="tendency_of_sea_ice_amount_due_to_snow_conversion" unit="kg/m2/s" /> 56 <field id="dmtsub" long_name="snow and sea ice mass change through sublimation" standard_name="tendency_of_snow_and_ice_amount_due_to_sublimation" unit="kg/m2/s" /> 57 <field id="dmssub" long_name="sea-ice mass change through evaporation and sublimation" standard_name="water_evaporation_flux" unit="kg/m2/s" /> 58 <field id="dmisub" long_name="snow mass change through evaporation or sublimation" standard_name="surface_snow_sublimation_flux" unit="kg/m2/s" /> 59 <field id="dmisum" long_name="sea-ice mass change through surface melting" standard_name="tendency_of_sea_ice_amount_due_to_surface_melting" unit="kg/m2/s" /> 60 <field id="dmibom" long_name="sea-ice mass change through bottom melting" standard_name="tendency_of_sea_ice_amount_due_to_basal_melting" unit="kg/m2/s" /> 61 62 <field id="dmsspr" long_name="snow mass change through snow fall" standard_name="snowfall_flux" unit="kg/m2/s" /> 63 <field id="dmsmel" long_name="snow mass change through melt" standard_name="surface_snow_melt_flux" unit="kg/m2/s" /> 64 <field id="dmsdyn" long_name="snow mass change through advection by sea-ice dynamics" standard_name="tendency_of_snow_mass_due_to_sea_ice_dynamics" unit="kg/m2/s" /> 65 <field id="dmsssi" long_name="snow mass change through snow-to-ice conversion" standard_name="tendency_of_snow_mass_due_to_snow_to_ice_conversion" unit="kg/m2/s" /> 66 67 <field id="hfxsenso" long_name="Net sensible heat flux under sea ice" standard_name="ice_ocean_heat_flux" unit="W/m2" /> 68 <field id="hfxconsu" long_name="Net conductive heat flux in ice at the surface" standard_name="conductive_heat_flux_at_sea_ice_surface" unit="W/m2" /> 69 <field id="hfxconbo" long_name="Net conductive heat fluxes in ice at the bottom" standard_name="conductive_heat_flux_at_sea_ice_bottom" unit="W/m2" /> 70 71 <field id="sfx_mv" long_name="Salt flux from sea ice" standard_name="salt_flux_from_ice" unit="kg/m2/s" /> 72 <field id="wfxtot" long_name="Freshwater flux from sea ice" standard_name="freshwater_flux_from_ice" unit="kg/m2/s" /> 73 74 <field id="utau_ice" long_name="X-component of atmospheric stress on sea ice" standard_name="surface_downward_x_stress" unit="N/m2" /> 75 <field id="vtau_ice" long_name="Y-component of atmospheric stress on sea ice" standard_name="surface_downward_y_stress" unit="N/m2" /> 76 77 <field id="utau_oi" long_name="X-component of ocean stress on sea ice" standard_name="sea_ice_base_upward_x_stress" unit="N/m2" /> 78 <field id="vtau_oi" long_name="Y-component of ocean stress on sea ice" standard_name="sea_ice_base_upward_y_stress" unit="N/m2" /> 79 80 <field id="icestr" long_name="Compressive sea ice strength" standard_name="compressive_strength_of_sea_ice" unit="N/m" /> 81 82 <field id="dssh_dx" long_name="Sea-surface tilt term in force balance (x-component)" standard_name="sea_surface_tilt_force_on_sea_ice_x" unit="N/m2" /> 83 <field id="dssh_dy" long_name="Sea-surface tilt term in force balance (y-component)" standard_name="sea_surface_tilt_force_on_sea_ice_y" unit="N/m2" /> 84 85 <field id="corstrx" long_name="Coriolis force term in force balance (x-component)" standard_name="coriolis_force_on_sea_ice_x" unit="N/m2" /> 86 <field id="corstry" long_name="Coriolis force term in force balance (y-component)" standard_name="coriolis_force_on_sea_ice_y" unit="N/m2" /> 87 88 <field id="intstrx" long_name="Internal stress term in force balance (x-component)" standard_name="internal_stress_in_sea_ice_x" unit="N/m2" /> 89 <field id="intstry" long_name="Internal stress term in force balance (y-component)" standard_name="internal_stress_in_sea_ice_y" unit="N/m2" /> 90 91 <field id="xmtrpice" long_name="X-component of ice mass transport" standard_name="ice_x_transport" unit="kg/s" /> 92 <field id="ymtrpice" long_name="Y-component of ice mass transport" standard_name="ice_y_transport" unit="kg/s" /> 93 94 <field id="xmtrpsnw" long_name="X-component of snw mass transport" standard_name="snw_x_transport" unit="kg/s" /> 95 <field id="ymtrpsnw" long_name="Y-component of snw mass transport" standard_name="snw_y_transport" unit="kg/s" /> 96 97 <field id="xatrp" long_name="X-component of ice area transport" standard_name="area_x_transport" unit="m2/s" /> 98 <field id="yatrp" long_name="Y-component of ice area transport" standard_name="area_y_transport" unit="m2/s" /> 99 100 <field id="xmtrptot" long_name="X-component of sea-ice mass transport" standard_name="sea_ice_x_transport" unit="kg/s" > xmtrpice + xmtrpsnw </field> 101 <field id="ymtrptot" long_name="Y-component of sea-ice mass transport" standard_name="sea_ice_y_transport" unit="kg/s" > ymtrpice + ymtrpsnw </field> 102 103 <field id="normstr" long_name="Average normal stress in sea ice" standard_name="average_normal_stress" unit="N/m" /> 104 <field id="sheastr" long_name="Maximum shear stress in sea ice" standard_name="maximum_shear_stress" unit="N/m" /> 105 106 <field id="idive" long_name="Divergence of the sea-ice velocity field" standard_name="divergence_of_sea_ice_velocity" unit="s-1" /> 107 <field id="ishear" long_name="Maximum shear of sea-ice velocity field" standard_name="maximum_shear_of_sea_ice_velocity" unit="s-1" /> 108 109 27 110 28 111 <!-- LIM3 fields --> 112 29 113 <field id="ice_cover" long_name="Ice fraction" standard_name="sea_ice_area_fraction" unit="1" /> 30 31 <field id="snowthic_cea" long_name="Snow thickness (cell average)" standard_name="surface_snow_thickness" unit="m" /> 32 <field id="icethic_cea" long_name="Ice thickness (cell average)" standard_name="sea_ice_thickness" unit="m" /> 33 34 <field id="uice_ipa" long_name="Ice velocity along i-axis at I-point (ice presence average)" standard_name="sea_ice_x_velocity" unit="m/s" /> 35 <field id="vice_ipa" long_name="Ice velocity along j-axis at I-point (ice presence average)" standard_name="sea_ice_y_velocity" unit="m/s" /> 36 <field id="utau_ice" long_name="Wind stress along i-axis over the ice at i-point" standard_name="surface_downward_x_stress" unit="N/m2" /> 37 <field id="vtau_ice" long_name="Wind stress along j-axis over the ice at i-point" standard_name="surface_downward_y_stress" unit="N/m2" /> 38 39 <field id="iceconc" long_name="ice concentration" standard_name="sea_ice_area_fraction" unit="%" /> 114 <field id="icepres" long_name="Ice presence" unit="" /> 115 116 <field id="uice_ipa" long_name="X-component of sea ice velocity" standard_name="sea_ice_x_velocity" unit="m/s" /> 117 <field id="vice_ipa" long_name="Y-component of sea ice velocity" standard_name="sea_ice_y_velocity" unit="m/s" /> 118 <field id="icevel" long_name="Sea-ice speed" standard_name="sea_ice_speed" unit="m/s" /> 40 119 <field id="isst" long_name="sea surface temperature" standard_name="sea_surface_temperature" unit="degC" /> 41 120 <field id="isss" long_name="sea surface salinity" standard_name="sea_surface_salinity" unit="1e-3" /> … … 48 127 <field id="qtr_ice" long_name="solar heat flux transmitted through ice: sum over categories" unit="W/m2" /> 49 128 <field id="qemp_ice" long_name="Downward Heat Flux from E-P over ice" unit="W/m2" /> 50 <field id="micesalt" long_name="Mean ice salinity" unit="1e-3" />51 <field id="miceage" long_name="Mean ice age" unit="years" />52 <field id="alb_ice" long_name="Mean albedo over sea ice" unit="" />53 129 <field id="albedo" long_name="Mean albedo over sea ice and ocean" unit="" /> 54 130 131 <field id="iceamp" long_name="melt pond fraction" standard_name="sea_ice_meltpond_fraction" unit="%" /> 132 <field id="icevmp" long_name="melt pond volume" standard_name="sea_ice_meltpond_volume" unit="m" /> 133 134 <field id="iceconc_cat" long_name="Sea-ice area fractions in thickness categories" unit="" grid_ref="grid_T_3D_ncatice" /> 135 <field id="icethic_cat" long_name="Sea-ice thickness in thickness categories" unit="m" grid_ref="grid_T_3D_ncatice" /> 136 <field id="snowthic_cat" long_name="Snow thickness in thickness categories" unit="m" grid_ref="grid_T_3D_ncatice" /> 55 137 <field id="iceage_cat" long_name="Ice age for categories" unit="days" grid_ref="grid_T_3D_ncatice" /> 56 <field id="iceconc_cat" long_name="Ice concentration for categories" unit="%" grid_ref="grid_T_3D_ncatice" />57 <field id="icethic_cat" long_name="Ice thickness for categories" unit="m" grid_ref="grid_T_3D_ncatice" />58 <field id="snowthic_cat" long_name="Snow thicknessi for categories" unit="m" grid_ref="grid_T_3D_ncatice" />59 138 <field id="salinity_cat" long_name="Sea-Ice Bulk salinity for categories" unit="g/kg" grid_ref="grid_T_3D_ncatice" /> 60 139 <field id="brinevol_cat" long_name="Brine volume for categories" unit="%" grid_ref="grid_T_3D_ncatice" /> 61 140 <field id="icetemp_cat" long_name="Ice temperature for categories" unit="degC" grid_ref="grid_T_3D_ncatice" /> 62 141 <field id="snwtemp_cat" long_name="Snow temperature for categories" unit="degC" grid_ref="grid_T_3D_ncatice" /> 142 <field id="iceamp_cat" long_name="Ice melt pond fraction for categories" unit="%" grid_ref="grid_T_3D_ncatice" /> 143 <field id="icevmp_cat" long_name="Ice melt pond volume for categories" unit="m" grid_ref="grid_T_3D_ncatice" /> 63 144 64 145 <field id="micet" long_name="Mean ice temperature" unit="degC" /> 65 <field id="icehc" long_name="ice total heat content" unit="10^9J" /> 66 <field id="isnowhc" long_name="snow total heat content" unit="10^9J" /> 146 <field id="miceage" long_name="Age of sea ice" unit="s" /> 147 <field id="micesalt" long_name="Sea ice salinity" unit="g/kg" /> 148 <field id="icehc" long_name="ice total heat content" unit="J/m2" /> 149 <field id="isnowhc" long_name="snow total heat content" unit="J/m2" /> 67 150 <field id="icest" long_name="ice surface temperature" unit="degC" /> 68 151 <field id="ibrinv" long_name="brine volume" unit="%" /> 69 152 <field id="icecolf" long_name="frazil ice collection thickness" unit="m" /> 70 <field id="icestr" long_name="ice strength" unit="N/m" />71 <field id="icevel" long_name="ice velocity" unit="m/s" />72 <field id="idive" long_name="divergence" unit="1e-8s-1" />73 <field id="ishear" long_name="shear" unit="1e-8s-1" />74 <field id="icevolu" long_name="ice volume" unit="m" />75 153 <field id="snowvol" long_name="snow volume" unit="m" /> 76 154 <field id="tau_icebfr" long_name="ice friction on ocean bottom for landfast ice" unit="N/2" /> 77 155 78 <field id="icetrp" long_name="ice volume transport" unit="m/day" />79 <field id="snwtrp" long_name="snw volume transport" unit="m/day" />80 <field id="saltrp" long_name="salt content transport" unit="1e-3*kg/m2/day" />156 <field id="icetrp" long_name="ice mass transport" unit="kg/m2/s" /> 157 <field id="snwtrp" long_name="snw mass transport" unit="kg/m2/s" /> 158 <field id="saltrp" long_name="salt transport" unit="1e-3*kg/m2/s" /> 81 159 <field id="deitrp" long_name="advected ice enthalpy" unit="W/m2" /> 82 160 <field id="destrp" long_name="advected snw enthalpy" unit="W/m2" /> 83 161 84 <field id="sfxbri" long_name="brine salt flux" unit="1e-3*kg/m2/day" /> 85 <field id="sfxdyn" long_name="salt flux from ridging rafting" unit="1e-3*kg/m2/day" /> 86 <field id="sfxres" long_name="salt flux from lipupdate (resultant)" unit="1e-3*kg/m2/day" /> 87 <field id="sfxbog" long_name="salt flux from bot growth" unit="1e-3*kg/m2/day" /> 88 <field id="sfxbom" long_name="salt flux from bot melt" unit="1e-3*kg/m2/day" /> 89 <field id="sfxsum" long_name="salt flux from surf melt" unit="1e-3*kg/m2/day" /> 90 <field id="sfxlam" long_name="salt flux from lateral melt" unit="1e-3*kg/m2/day" /> 91 <field id="sfxsni" long_name="salt flux from snow-ice formation" unit="1e-3*kg/m2/day" /> 92 <field id="sfxopw" long_name="salt flux from open water ice formation" unit="1e-3*kg/m2/day" /> 93 <field id="sfxsub" long_name="salt flux from sublimation" unit="1e-3*kg/m2/day" /> 94 <field id="sfx" long_name="salt flux total" unit="1e-3*kg/m2/day" /> 95 96 <field id="vfxbog" long_name="daily bottom thermo ice prod." unit="m/day" /> 97 <field id="vfxdyn" long_name="daily dynamic ice prod." unit="m/day" /> 98 <field id="vfxopw" long_name="daily lateral thermo ice prod." unit="m/day" /> 99 <field id="vfxsni" long_name="daily snowice ice prod." unit="m/day" /> 100 <field id="vfxsum" long_name="surface melt" unit="m/day" /> 101 <field id="vfxlam" long_name="lateral melt" unit="m/day" /> 102 <field id="vfxbom" long_name="bottom melt" unit="m/day" /> 103 <field id="vfxres" long_name="daily resultant ice prod./melting from limupdate" unit="m/day" /> 104 <field id="vfxice" long_name="ice melt/growth" unit="m/day" /> 105 <field id="vfxsnw" long_name="snw melt/growth" unit="m/day" /> 106 <field id="vfxsub" long_name="snw sublimation" unit="m/day" /> 107 <field id="vfxsub_err" long_name="excess of snw sublimation sent to ocean" unit="m/day" /> 108 <field id="vfxspr" long_name="snw precipitation on ice" unit="m/day" /> 109 <field id="vfxthin" long_name="daily thermo ice prod. for thin ice(20cm) + open water" unit="m/day" /> 110 111 <field id="afxtot" long_name="area tendency (total)" unit="day-1" /> 112 <field id="afxdyn" long_name="area tendency (dynamics)" unit="day-1" /> 113 <field id="afxthd" long_name="area tendency (thermo)" unit="day-1" /> 162 <field id="sfxbri" long_name="salt flux from brines" unit="1e-3*kg/m2/s" /> 163 <field id="sfxdyn" long_name="salt flux from ridging rafting" unit="1e-3*kg/m2/s" /> 164 <field id="sfxres" long_name="salt flux from lipupdate (resultant)" unit="1e-3*kg/m2/s" /> 165 <field id="sfxbog" long_name="salt flux from bot growth" unit="1e-3*kg/m2/s" /> 166 <field id="sfxbom" long_name="salt flux from bot melt" unit="1e-3*kg/m2/s" /> 167 <field id="sfxsum" long_name="salt flux from surf melt" unit="1e-3*kg/m2/s" /> 168 <field id="sfxlam" long_name="salt flux from lateral melt" unit="1e-3*kg/m2/s" /> 169 <field id="sfxsni" long_name="salt flux from snow-ice formation" unit="1e-3*kg/m2/s" /> 170 <field id="sfxopw" long_name="salt flux from open water ice formation" unit="1e-3*kg/m2/s" /> 171 <field id="sfxsub" long_name="salt flux from sublimation" unit="1e-3*kg/m2/s" /> 172 <field id="sfx" long_name="Salt flux from sea ice" unit="1e-3*kg/m2/s" /> 173 174 <field id="vfxbog" long_name="bottom thermo ice prod." unit="kg/m2/s" /> 175 <field id="vfxdyn" long_name="dynamic ice prod." unit="kg/m2/s" /> 176 <field id="vfxopw" long_name="lateral thermo ice prod." unit="kg/m2/s" /> 177 <field id="vfxsni" long_name="snowice ice prod." unit="kg/m2/s" /> 178 <field id="vfxsum" long_name="surface melt" unit="kg/m2/s" /> 179 <field id="vfxlam" long_name="lateral melt" unit="kg/m2/s" /> 180 <field id="vfxbom" long_name="bottom melt" unit="kg/m2/s" /> 181 <field id="vfxres" long_name="resultant ice prod./melting" unit="kg/m2/s" /> 182 <field id="vfxice" long_name="ice melt/growth" unit="kg/m2/s" /> 183 <field id="vfxsnw" long_name="snw melt/growth" unit="kg/m2/s" /> 184 <field id="vfxsub" long_name="snw sublimation" unit="kg/m2/s" /> 185 <field id="vfxsub_err" long_name="excess of snw sublimation sent to ocean" unit="kg/m2/s" /> 186 <field id="vfxspr" long_name="snw precipitation on ice" unit="kg/m2/s" /> 187 <field id="vfxthin" long_name="thermo ice prod. for thin ice(20cm) + open water" unit="kg/m2/s" /> 188 189 <field id="afxtot" long_name="area tendency (total)" unit="s-1" /> 114 190 115 191 <field id="hfxsum" long_name="heat fluxes causing surface ice melt" unit="W/m2" /> … … 135 211 <field id="hfxtur" long_name="turbulent heat flux at the ice base" unit="W/m2" /> 136 212 137 <!-- sbcssm variables -->213 <!-- sbcssm variables --> 138 214 <field id="sst_m" unit="degC" /> 139 215 <field id="sss_m" unit="psu" /> … … 144 220 <field id="frq_m" unit="-" /> 145 221 222 <!-- specific for rheology --> 223 <field id="isig1" long_name="1st principal stress component for EVP rhg" unit="unitless" /> 224 <field id="isig2" long_name="2nd principal stress component for EVP rhg" unit="unitless" /> 225 <field id="isig3" long_name="convergence measure for EVP rheology (must be =1)" unit="unitless" /> 226 146 227 </field_group> 147 228 … … 149 230 <field_group id="SBC_scalar" grid_ref="grid_T_2D" > 150 231 <!-- available with ln_limdiaout --> 151 <field id="ibgfrcvoltop" long_name="global mean ice/snow forcing at interface ice/snow-atm (volume equivalent ocean volume)" unit="km3" />152 <field id="ibgfrcvolbot" long_name="global mean ice/snow forcing at interface ice/snow-ocean (volume equivalent ocean volume)" unit="km3" />153 <field id="ibgfrctemtop" long_name="global mean heat on top of ice/snw/ocean-atm " unit="1e20J" />154 <field id="ibgfrctembot" long_name="global mean heat below ice (on top of ocean) " unit="1e20J" />155 <field id="ibgfrcsal" long_name="global mean ice/snow forcing (salt equivalent ocean volume)" unit="pss*km3" />156 <field id="ibgfrchfxtop" long_name="global mean heat flux on top of ice/snw/ocean-atm " unit="W/m2" />157 <field id="ibgfrchfxbot" long_name="global mean heat flux below ice (on top of ocean) " unit="W/m2" />232 <field id="ibgfrcvoltop" long_name="global mean ice/snow forcing at interface ice/snow-atm (volume equivalent ocean volume)" unit="km3" /> 233 <field id="ibgfrcvolbot" long_name="global mean ice/snow forcing at interface ice/snow-ocean (volume equivalent ocean volume)" unit="km3" /> 234 <field id="ibgfrctemtop" long_name="global mean heat on top of ice/snw/ocean-atm " unit="1e20J" /> 235 <field id="ibgfrctembot" long_name="global mean heat below ice (on top of ocean) " unit="1e20J" /> 236 <field id="ibgfrcsal" long_name="global mean ice/snow forcing (salt equivalent ocean volume)" unit="pss*km3" /> 237 <field id="ibgfrchfxtop" long_name="global mean heat flux on top of ice/snw/ocean-atm " unit="W/m2" /> 238 <field id="ibgfrchfxbot" long_name="global mean heat flux below ice (on top of ocean) " unit="W/m2" /> 158 239 159 <field id="ibgvolume" long_name="drift in ice/snow volume (equivalent ocean volume)" unit="km3" /> 160 <field id="ibgsaltco" long_name="drift in ice salt content (equivalent ocean volume)" unit="pss*km3" /> 161 <field id="ibgheatco" long_name="drift in ice/snow heat content" unit="1e20J" /> 162 <field id="ibgheatfx" long_name="drift in ice/snow heat flux" unit="W/m2" /> 163 164 <field id="ibgvol_tot" long_name="global mean ice volume" unit="km3" /> 165 <field id="sbgvol_tot" long_name="global mean snow volume" unit="km3" /> 166 <field id="ibgarea_tot" long_name="global mean ice area" unit="km2" /> 167 <field id="ibgsalt_tot" long_name="global mean ice salt content" unit="1e-3*km3" /> 168 <field id="ibgheat_tot" long_name="global mean ice heat content" unit="1e20J" /> 169 <field id="sbgheat_tot" long_name="global mean snow heat content" unit="1e20J" /> 240 <field id="ibgvolume" long_name="drift in ice/snow volume (equivalent ocean volume)" unit="km3" /> 241 <field id="ibgsaltco" long_name="drift in ice salt content (equivalent ocean volume)" unit="pss*km3" /> 242 <field id="ibgheatco" long_name="drift in ice/snow heat content" unit="1e20J" /> 243 <field id="ibgheatfx" long_name="drift in ice/snow heat flux" unit="W/m2" /> 244 245 <field id="ibgvol_tot" long_name="global mean ice volume" unit="km3" /> 246 <field id="sbgvol_tot" long_name="global mean snow volume" unit="km3" /> 247 <field id="ibgarea_tot" long_name="global mean ice area" unit="km2" /> 248 <field id="ibgsalt_tot" long_name="global mean ice salt content" unit="1e-3*km3" /> 249 <field id="ibgheat_tot" long_name="global mean ice heat content" unit="1e20J" /> 250 <field id="sbgheat_tot" long_name="global mean snow heat content" unit="1e20J" /> 251 252 <field id="NH_iceextt" long_name="Sea ice extent North" standard_name="sea_ice_extent_n" unit="1e6_km2" /> 253 <field id="SH_iceextt" long_name="Sea ice extent South" standard_name="sea_ice_extent_s" unit="1e6_km2" /> 254 <field id="NH_icevolu" long_name="Sea ice volume North" standard_name="sea_ice_volume_n" unit="1e3_km3" /> 255 <field id="SH_icevolu" long_name="Sea ice volume South" standard_name="sea_ice_volume_s" unit="1e3_km3" /> 256 <field id="NH_icearea" long_name="Sea ice area North" standard_name="sea_ice_area_n" unit="1e6_km2" /> 257 <field id="SH_icearea" long_name="Sea ice area South" standard_name="sea_ice_area_s" unit="1e6_km2" /> 258 259 <field id="strait_mifl" long_name="Sea ice mass flux through straits" standard_name="sea_ice_mass_transport_across_line" unit="kg/s" grid_ref="grid_4strait" /> 260 <field id="strait_arfl" long_name="Sea ice area flux through straits" standard_name="sea_ice_area_transport_across_line" unit="m2/s" grid_ref="grid_4strait" /> 261 <field id="strait_msfl" long_name="Sea ice snow flux through straits" standard_name="snow_mass_transport_across_line" unit="kg/s" grid_ref="grid_4strait" /> 262 170 263 </field_group> 171 264 … … 176 269 177 270 <field_group id="myvarICE" > 178 <field field_ref="icethic _cea"name="sithic" long_name="sea_ice_thickness" />271 <field field_ref="icethick" name="sithic" long_name="sea_ice_thickness" /> 179 272 <field field_ref="icevolu" name="sivolu" /> 180 273 <field field_ref="iceconc" name="siconc" /> 181 274 </field_group> 182 275 276 <field_group id="ICE_globalbudget"> 277 278 <field field_ref="ibgvol_tot" grid_ref="grid_1point" name="ibgvol_tot" /> 279 <field field_ref="sbgvol_tot" grid_ref="grid_1point" name="sbgvol_tot" /> 280 <field field_ref="ibgarea_tot" grid_ref="grid_1point" name="ibgarea_tot" /> 281 <field field_ref="ibgsalt_tot" grid_ref="grid_1point" name="ibgsalt_tot" /> 282 <field field_ref="ibgheat_tot" grid_ref="grid_1point" name="ibgheat_tot" /> 283 <field field_ref="sbgheat_tot" grid_ref="grid_1point" name="sbgheat_tot" /> 284 285 <field field_ref="ibgvolume" grid_ref="grid_1point" name="ibgvolume" /> 286 <field field_ref="ibgsaltco" grid_ref="grid_1point" name="ibgsaltco" /> 287 <field field_ref="ibgheatco" grid_ref="grid_1point" name="ibgheatco" /> 288 <field field_ref="ibgheatfx" grid_ref="grid_1point" name="ibgheatfx" /> 289 290 <field field_ref="ibgfrcvoltop" grid_ref="grid_1point" name="ibgfrcvoltop" /> 291 <field field_ref="ibgfrcvolbot" grid_ref="grid_1point" name="ibgfrcvolbot" /> 292 <field field_ref="ibgfrctemtop" grid_ref="grid_1point" name="ibgfrctemtop" /> 293 <field field_ref="ibgfrctembot" grid_ref="grid_1point" name="ibgfrctembot" /> 294 <field field_ref="ibgfrcsal" grid_ref="grid_1point" name="ibgfrcsal" /> 295 <field field_ref="ibgfrchfxtop" grid_ref="grid_1point" name="ibgfrchfxtop" /> 296 <field field_ref="ibgfrchfxbot" grid_ref="grid_1point" name="ibgfrchfxbot" /> 297 298 </field_group> 299 300 301 <!--============================--> 302 <!-- SIMIP sea ice field groups --> 303 <!-- Notz et al 2016 --> 304 <!--============================--> 305 306 <!-- SIMIP monthly scalar variables --> 307 <field_group id="SImon_scalars"> 308 <!-- Integrated quantities --> 309 <field field_ref="NH_iceextt" grid_ref="grid_1point" name="siextentn" /> 310 <field field_ref="SH_iceextt" grid_ref="grid_1point" name="siextents" /> 311 <field field_ref="NH_icevolu" grid_ref="grid_1point" name="sivoln" /> 312 <field field_ref="SH_icevolu" grid_ref="grid_1point" name="sivols" /> 313 <field field_ref="NH_icearea" grid_ref="grid_1point" name="siarean" /> 314 <field field_ref="SH_icearea" grid_ref="grid_1point" name="siareas" /> 315 </field_group> 316 317 <!-- SIMIP daily fields --> <field_group id="SIday_fields"> 318 <field field_ref="icepres" name="sitimefrac" /> 319 <field field_ref="iceconc_pct" name="siconc" /> 320 <field field_ref="icethic" name="sithick" default_value="1.0e20" detect_missing_value="true" operation="average" /> 321 <field field_ref="snothic" name="sisnthick" default_value="1.0e20" detect_missing_value="true" operation="average" /> 322 <field field_ref="icestK" name="sitemptop" default_value="1.0e20" detect_missing_value="true" operation="average" /> 323 <field field_ref="uice_mv" name="siu" default_value="1.0e20" detect_missing_value="true" operation="average" /> 324 <field field_ref="vice_mv" name="siv" default_value="1.0e20" detect_missing_value="true" operation="average" /> 325 <field field_ref="icevel_mv" name="sispeed" default_value="1.0e20" detect_missing_value="true" operation="average" /> 326 </field_group> 327 328 <!-- SIMIP monthly fields --> 329 <field_group id="SImon_fields"> 330 <!-- Sea-ice state variables --> 331 <field field_ref="icepres" name="sitimefrac" /> 332 <field field_ref="iceconc_pct" name="siconc" /> 333 <field field_ref="icemass" name="simass" /> 334 <field field_ref="icethic" name="sithick" default_value="1.0e20" detect_missing_value="true" operation="average" /> 335 <field field_ref="icevolu" name="sivol" /> 336 <field field_ref="snomass" name="sisnmass" default_value="1.0e20" detect_missing_value="true" operation="average" /> 337 <field field_ref="snothic" name="sisnthick" default_value="1.0e20" detect_missing_value="true" operation="average" /> 338 339 <!-- category-dependent fields --> 340 <field field_ref="iceconc_cat_pct_mv" name="siitdconc" default_value="1.0e20" detect_missing_value="true" operation="average" /> 341 <field field_ref="icethic_cat_mv" name="siitdthick" default_value="1.0e20" detect_missing_value="true" operation="average" /> 342 <field field_ref="snowthic_cat_mv" name="siitdsnthick" default_value="1.0e20" detect_missing_value="true" operation="average"/> 343 344 <!-- additional state variables--> 345 <field field_ref="icestK" name="sitemptop" default_value="1.0e20" detect_missing_value="true" operation="average" /> 346 <field field_ref="icesntK" name="sitempsnic" default_value="1.0e20" detect_missing_value="true" operation="average" /> 347 <field field_ref="icebotK" name="sitempbot" default_value="1.0e20" detect_missing_value="true" operation="average" /> 348 <field field_ref="iceage" name="siage" default_value="1.0e20" detect_missing_value="true" operation="average" /> 349 <field field_ref="icesmass" name="sisaltmass" /> 350 <field field_ref="icesal" name="sisali" default_value="1.0e20" detect_missing_value="true" operation="average" /> 351 <field field_ref="icefb" name="sifb" default_value="1.0e20" detect_missing_value="true" operation="average" /> 352 <field field_ref="icehcneg" name="sihc" /> 353 <field field_ref="isnhcneg" name="sisnhc" default_value="1.0e20" detect_missing_value="true" operation="average" /> 354 355 <!-- freshwater fluxes --> 356 <field field_ref="wfxtot" name="siflfwbot" default_value="1.0e20" detect_missing_value="true" operation="average" /> 357 <field field_ref="wfxsum" name="siflfwdrain" default_value="1.0e20" detect_missing_value="true" operation="average" /> 358 359 <!-- area balance --> 360 <field field_ref="afxthd" name="sidconcth" /> 361 <field field_ref="afxdyn" name="sidconcdyn" /> 362 363 <!-- mass balance --> 364 <field field_ref="dmithd" name="sidmassth" /> 365 <field field_ref="dmidyn" name="sidmassdyn" /> 366 <field field_ref="dmiopw" name="sidmassgrowthwat" /> 367 <field field_ref="dmibog" name="sidmassgrowthbot" /> 368 <field field_ref="dmisni" name="sidmasssi" /> 369 <field field_ref="dmisub" name="sidmassevapsubl" /> 370 <field field_ref="dmisum" name="sidmassmelttop" /> 371 <field field_ref="dmibom" name="sidmassmeltbot" /> 372 <field field_ref="dmsspr" name="sndmasssnf" /> 373 <field field_ref="dmsmel" name="sndmassmelt" /> 374 <field field_ref="dmssub" name="sndmasssubl" /> 375 <field field_ref="dmsdyn" name="sndmassdyn" /> 376 <field field_ref="dmsssi" name="sndmasssi" /> 377 378 <!-- heat balance --> 379 <field field_ref="hfxsenso" name="siflsensupbot" default_value="1.0e20" detect_missing_value="true" operation="average" /> 380 <field field_ref="hfxconsu" name="siflcondtop" default_value="1.0e20" detect_missing_value="true" operation="average" /> 381 <field field_ref="hfxconbo" name="siflcondbot" default_value="1.0e20" detect_missing_value="true" operation="average" /> 382 383 <!-- salt balance --> 384 <field field_ref="sfx_mv" name="siflsaltbot" default_value="1.0e20" detect_missing_value="true" operation="average" /> 385 386 <!-- sea-ice dynamics --> 387 <field field_ref="uice_mv" name="siu" default_value="1.0e20" detect_missing_value="true" operation="average" /> 388 <field field_ref="vice_mv" name="siv" default_value="1.0e20" detect_missing_value="true" operation="average" /> 389 <field field_ref="icevel_mv" name="sispeed" default_value="1.0e20" detect_missing_value="true" operation="average" /> 390 391 <field field_ref="utau_ice" name="sistrxdtop" default_value="1.0e20" detect_missing_value="true" operation="average" /> 392 <field field_ref="vtau_ice" name="sistrydtop" default_value="1.0e20" detect_missing_value="true" operation="average" /> 393 394 <field field_ref="utau_oi" name="sistrxubot" default_value="1.0e20" detect_missing_value="true" operation="average" /> 395 <field field_ref="vtau_oi" name="sistryubot" default_value="1.0e20" detect_missing_value="true" operation="average" /> 396 397 <field field_ref="icestr" name="sicompstren" default_value="1.0e20" detect_missing_value="true" operation="average" /> 398 399 <field field_ref="dssh_dx" name="siforcetiltx" default_value="1.0e20" detect_missing_value="true" operation="average" /> 400 <field field_ref="dssh_dy" name="siforcetilty" default_value="1.0e20" detect_missing_value="true" operation="average" /> 401 402 <field field_ref="corstrx" name="siforcecoriolx" default_value="1.0e20" detect_missing_value="true" operation="average" /> 403 <field field_ref="corstry" name="siforcecorioly" default_value="1.0e20" detect_missing_value="true" operation="average" /> 404 405 <field field_ref="intstrx" name="siforceintstrx" default_value="1.0e20" detect_missing_value="true" operation="average" /> 406 <field field_ref="intstry" name="siforceintstry" default_value="1.0e20" detect_missing_value="true" operation="average" /> 407 408 <field field_ref="xmtrptot" name="sidmasstranx" /> 409 <field field_ref="ymtrptot" name="sidmasstrany" /> 410 411 <field field_ref="normstr" name="sistresave" default_value="1.0e20" detect_missing_value="true" operation="instant" /> 412 <field field_ref="sheastr" name="sistremax" default_value="1.0e20" detect_missing_value="true" operation="instant" /> 413 414 <field field_ref="idive" name="sidivvel" default_value="1.0e20" detect_missing_value="true" operation="instant" /> 415 <field field_ref="ishear" name="sishevel" default_value="1.0e20" detect_missing_value="true" operation="instant" /> 416 417 <!-- sea ice fluxes across straits: 2D arrays to be post-processed --> 418 <field field_ref="xmtrpice" name="simassacrossline_x" /> 419 <field field_ref="ymtrpice" name="simassacrossline_y" /> 420 <field field_ref="xmtrpsnw" name="snmassacrossline_x" /> 421 <field field_ref="ymtrpsnw" name="snmassacrossline_y" /> 422 <field field_ref="xatrp" name="siareaacrossline_x" /> 423 <field field_ref="yatrp" name="siareaacrossline_y" /> 424 425 </field_group> 426 183 427 </field_definition> -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/namelist_ice_lim3_ref
r7813 r8738 1 1 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 2 !! LIM3 namelist: 3 !! 1 - Generic parameters (namicerun) 4 !! 2 - Diagnostics (namicediag) 5 !! 3 - Ice initialization (namiceini) 6 !! 4 - Ice discretization (namiceitd) 7 !! 5 - Ice dynamics and transport (namicedyn) 8 !! 6 - Ice diffusion (namicehdf) 9 !! 7 - Ice thermodynamics (namicethd) 10 !! 8 - Ice salinity (namicesal) 11 !! 9 - Ice mechanical redistribution (namiceitdme) 2 !! ESIM namelist: 3 !! 1 - Generic parameters (nampar) 4 !! 2 - Ice thickness discretization (namitd) 5 !! 3 - Ice dynamics (namdyn) 6 !! 4 - Ice ridging/rafting (namdyn_rdgrft) 7 !! 5 - Ice rheology (namdyn_rhg) 8 !! 6 - Ice advection (namdyn_adv) 9 !! 7 - Ice surface forcing (namforcing) 10 !! 8 - Ice thermodynamics (namthd) 11 !! 9 - Ice heat diffusion (namthd_zdf) 12 !! 10 - Ice lateral melting (namthd_da) 13 !! 11 - Ice growth in open water (namthd_do) 14 !! 12 - Ice salinity (namthd_sal) 15 !! 13 - Ice melt ponds (nammp) 16 !! 14 - Ice initialization (namini) 17 !! 15 - Ice/snow albedos (namalb) 18 !! 16 - Ice diagnostics (namdia) 12 19 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 13 20 ! 14 21 !------------------------------------------------------------------------------ 15 &namicerun ! Generic parameters 16 !------------------------------------------------------------------------------ 17 jpl = 5 ! number of ice categories 18 nlay_i = 2 ! number of ice layers 19 nlay_s = 1 ! number of snow layers (only 1 is working) 20 rn_amax_n = 0.997 ! maximum tolerated ice concentration NH 21 rn_amax_s = 0.997 ! maximum tolerated ice concentration SH 22 cn_icerst_in = "restart_ice" ! suffix of ice restart name (input) 23 cn_icerst_out = "restart_ice" ! suffix of ice restart name (output) 24 cn_icerst_indir = "." ! directory to read input ice restarts 25 cn_icerst_outdir = "." ! directory to write output ice restarts 26 ln_limthd = .true. ! ice thermo (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 27 ln_limdyn = .true. ! ice dynamics (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 28 nn_limdyn = 2 ! (ln_limdyn=T) switch for ice dynamics 29 ! 2: total 30 ! 1: advection only (no diffusion, no ridging/rafting) 31 ! 0: advection only (as 1 but with prescribed velocity, bypass rheology) 32 rn_uice = 0.00001 ! (nn_limdyn=0) ice u-velocity 33 rn_vice = -0.00001 ! (nn_limdyn=0) ice v-velocity 34 / 35 !------------------------------------------------------------------------------ 36 &namicediag ! Diagnostics 37 !------------------------------------------------------------------------------ 38 ln_limdiachk = .false. ! check online the heat, mass & salt budgets (T) or not (F) 39 ln_limdiahsb = .false. ! output the heat, mass & salt budgets (T) or not (F) 40 ln_limctl = .false. ! ice points output for debug (T or F) 41 iiceprt = 10 ! i-index for debug 42 jiceprt = 10 ! j-index for debug 43 / 44 !------------------------------------------------------------------------------ 45 &namiceini ! Ice initialization 46 !------------------------------------------------------------------------------ 47 ! -- limistate -- ! 48 ln_limini = .true. ! activate ice initialization (T) or not (F) 49 ln_limini_file = .false. ! netcdf file provided for initialization (T) or not (F) 50 rn_thres_sst = 2.0 ! maximum water temperature with initial ice (degC) 51 rn_hts_ini_n = 0.3 ! initial real snow thickness (m), North 52 rn_hts_ini_s = 0.3 ! " " South 53 rn_hti_ini_n = 3.0 ! initial real ice thickness (m), North 54 rn_hti_ini_s = 1.0 ! " " South 55 rn_ati_ini_n = 0.9 ! initial ice concentration (-), North 56 rn_ati_ini_s = 0.9 ! " " South 57 rn_smi_ini_n = 6.3 ! initial ice salinity (g/kg), North 58 rn_smi_ini_s = 6.3 ! " " South 59 rn_tmi_ini_n = 270. ! initial ice/snw temperature (K), North 60 rn_tmi_ini_s = 270. ! " " South 61 / 62 !------------------------------------------------------------------------------ 63 &namiceitd ! Ice discretization 64 !------------------------------------------------------------------------------ 65 nn_catbnd = 2 ! computation of ice category boundaries based on 66 ! 1: tanh function 67 ! 2: h^(-alpha), function of rn_himean 68 rn_himean = 2.0 ! expected domain-average ice thickness (m), nn_catbnd = 2 only 69 / 70 !------------------------------------------------------------------------------ 71 &namicedyn ! Ice dynamics and transport 72 !------------------------------------------------------------------------------ 73 ! -- limtrp & limadv -- ! 74 nn_limadv = 0 ! choose the advection scheme (-1=Prather ; 0=Ultimate-Macho) 75 nn_limadv_ord = 5 ! choose the order of the advection scheme (if nn_limadv=0) 76 ! -- limitd_me -- ! 77 nn_icestr = 0 ! ice strength parameteriztaion 78 ! 0: Hibler_79 P = pstar*<h>*exp(-c_rhg*A) 79 ! 1: Rothrock_75 P = Cf*coeff*integral(wr.h^2) 80 rn_pe_rdg = 17.0 ! (nn_icestr=1) ridging work divided by pot. energy change in ridging 81 rn_pstar = 2.0e+04 ! (nn_icestr=0) ice strength thickness parameter (N/m2) 82 rn_crhg = 20.0 ! (nn_icestr=0) ice strength conc. parameter (-) 83 ln_icestr_bvf = .false. ! ice strength function brine volume (T) or not (F) 84 ! 85 ! -- limdyn & limrhg -- ! 86 rn_cio = 5.0e-03 ! ice-ocean drag coefficient (-) 87 rn_creepl = 1.0e-12 ! creep limit (s-1) 88 rn_ecc = 2.0 ! eccentricity of the elliptical yield curve 89 nn_nevp = 120 ! number of EVP subcycles 90 rn_relast = 0.333 ! ratio of elastic timescale to ice time step: Telast = dt_ice * rn_relast 91 ! advised value: 1/3 (rn_nevp=120) or 1/9 (rn_nevp=300) 92 ln_landfast = .false. ! landfast ice parameterization (T or F) 93 rn_gamma = 0.15 ! (ln_landfast=T) fraction of ocean depth that ice must reach to initiate landfast 94 ! recommended range: [0.1 ; 0.25] 95 rn_icebfr = 10. ! (ln_landfast=T) maximum bottom stress per unit area of contact (N/m2) 96 ! a very large value ensures ice velocity=0 even with a small contact area 97 ! recommended range: ?? (should be greater than atm-ice stress => >0.1 N/m2) 98 rn_lfrelax = 1.e-5 ! (ln_landfast=T) relaxation time scale to reach static friction (s-1) 99 / 100 !------------------------------------------------------------------------------ 101 &namicehdf ! Ice horizontal diffusion 102 !------------------------------------------------------------------------------ 103 ! -- limhdf -- ! 104 nn_ahi0 = -1 ! horizontal diffusivity computation 105 ! -1: no diffusion (bypass limhdf) 106 ! 0: use rn_ahi0_ref 107 ! 1: use rn_ahi0_ref x mean grid cell length / ( 2deg mean grid cell length ) 108 ! 2: use rn_ahi0_ref x grid cell length / ( 2deg mean grid cell length ) 109 rn_ahi0_ref = 350.0 ! horizontal sea ice diffusivity (m2/s) 110 ! if nn_ahi0 > 0, rn_ahi0_ref is the reference value at a nominal 2 deg resolution 111 / 112 !------------------------------------------------------------------------------ 113 &namicethd ! Ice thermodynamics 114 !------------------------------------------------------------------------------ 115 ! -- limthd_dif -- ! 116 rn_kappa_i = 1.0 ! radiation attenuation coefficient in sea ice (m-1) 117 nn_conv_dif = 50 ! maximal number of iterations for heat diffusion computation 118 rn_terr_dif = 1.0e-04 ! maximum temperature after heat diffusion (degC) 119 nn_ice_thcon = 1 ! sea ice thermal conductivity 120 ! 0: k = k0 + beta.S/T (Untersteiner, 1964) 121 ! 1: k = k0 + beta1.S/T - beta2.T (Pringle et al., 2007) 122 ln_it_qnsice = .true. ! iterate the surface non-solar flux with surface temperature (T) or not (F) 123 nn_monocat = 0 ! virtual ITD mono-category parameterizations (1, jpl = 1 only) or not (0) 124 ! 2: simple piling instead of ridging --- temporary option 125 ! 3: activate G(he) only --- temporary option 126 ! 4: activate extra lateral melting only --- temporary option 127 rn_cdsn = 0.31 ! thermal conductivity of the snow (0.31 W/m/K, Maykut and Untersteiner, 1971) 128 ! Obs: 0.1-0.5 (Lecomte et al, JAMES 2013) 129 ! -- limthd_dh -- ! 130 ln_limdH = .true. ! activate ice thickness change from growing/melting (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 131 rn_betas = 0.66 ! exponent in lead-ice repratition of snow precipitation 132 ! betas = 1 -> equipartition, betas < 1 -> more on leads 133 ! -- limthd_da -- ! 134 ln_limdA = .true. ! activate lateral melting param. (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 135 rn_beta = 1.0 ! (ln_latmelt=T) coef. beta for lateral melting param. Recommended range=[0.8-1.2] 136 ! => decrease = more melt and melt peaks toward higher concentration (A~0.5 for beta=1 ; A~0.8 for beta=0.2) 137 ! 0.3 = best fit for western Fram Strait and Antarctica 138 ! 1.4 = best fit for eastern Fram Strait 139 rn_dmin = 8. ! (ln_latmelt=T) minimum floe diameter for lateral melting param. Recommended range=[6-10] 140 ! => 6 vs 8m = +40% melting at the peak (A~0.5) 141 ! 10 vs 8m = -20% melting 142 ! -- limthd_lac -- ! 143 ln_limdO = .true. ! activate ice growth in open-water (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 144 rn_hnewice = 0.1 ! thickness for new ice formation in open water (m) 145 ln_frazil = .false. ! Frazil ice parameterization (ice collection as a function of wind) 146 rn_maxfrazb = 1.0 ! (ln_frazil=T) maximum fraction of frazil ice collecting at the ice base 147 rn_vfrazb = 0.417 ! (ln_frazil=T) thresold drift speed for frazil ice collecting at the ice bottom (m/s) 148 rn_Cfrazb = 5.0 ! (ln_frazil=T) squeezing coefficient for frazil ice collecting at the ice bottom 149 ! -- limitd_th -- ! 150 rn_himin = 0.1 ! minimum ice thickness (m) used in remapping, must be smaller than rn_hnewice 151 / 152 !------------------------------------------------------------------------------ 153 &namicesal ! Ice salinity 154 !------------------------------------------------------------------------------ 155 ! -- limthd_sal -- ! 156 ln_limdS = .true. ! activate gravity drainage and flushing (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 157 nn_icesal = 2 ! ice salinity option 158 ! 1: constant ice salinity (S=rn_icesal) 159 ! 2: varying salinity parameterization S(z,t) 160 ! 3: prescribed salinity profile S(z), Schwarzacher, 1959 161 rn_icesal = 4. ! (nn_icesal=1) ice salinity (g/kg) 162 rn_sal_gd = 5. ! restoring ice salinity, gravity drainage (g/kg) 163 rn_time_gd = 1.73e+6 ! restoring time scale, gravity drainage (s) 164 rn_sal_fl = 2. ! restoring ice salinity, flushing (g/kg) 165 rn_time_fl = 8.64e+5 ! restoring time scale, flushing (s) 166 rn_simax = 20. ! maximum tolerated ice salinity (g/kg) 167 rn_simin = 0.1 ! minimum tolerated ice salinity (g/kg) 168 / 169 !------------------------------------------------------------------------------ 170 &namiceitdme ! Ice mechanical redistribution (ridging and rafting) 171 !------------------------------------------------------------------------------ 172 ! -- limitd_me -- ! 173 rn_cs = 0.5 ! fraction of shearing energy contributing to ridging 174 nn_partfun = 1 ! type of ridging participation function 175 ! 0: linear (Thorndike et al, 1975) 176 ! 1: exponential (Lipscomb, 2007) 177 rn_gstar = 0.15 ! (nn_partfun = 0) fractional area of thin ice being ridged 178 rn_astar = 0.03 ! (nn_partfun = 1) exponential measure of ridging ice fraction [set to 0.05 if hstar=100] 179 ln_ridging = .true. ! ridging activated (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 180 rn_hstar = 25.0 ! (ln_ridging = T) determines the maximum thickness of ridged ice (m) (Hibler, 1980) 181 rn_por_rdg = 0.3 ! (ln_ridging = T) porosity of newly ridged ice (Lepparanta et al., 1995) 182 rn_fsnowrdg = 0.5 ! (ln_ridging = T) snow volume fraction that survives in ridging 183 ln_rafting = .true. ! rafting activated (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 184 rn_hraft = 0.75 ! (ln_rafting = T) threshold thickness for rafting (m) 185 rn_craft = 5.0 ! (ln_rafting = T) squeezing coefficient used in the rafting function 186 rn_fsnowrft = 0.5 ! (ln_rafting = T) snow volume fraction that survives in rafting 187 / 22 &nampar ! Generic parameters 23 !------------------------------------------------------------------------------ 24 jpl = 5 ! number of ice categories 25 nlay_i = 2 ! number of ice layers 26 nlay_s = 1 ! number of snow layers (only 1 is working) 27 nn_monocat = 0 ! virtual ITD mono-category parameterizations (1-4 => jpl = 1 only) or not (0) 28 ! 2: simple piling instead of ridging --- temporary option 29 ! 3: activate G(he) only --- temporary option 30 ! 4: activate extra lateral melting only --- temporary option 31 ln_icedyn = .true. ! ice dynamics (T) or not (F) 32 ln_icethd = .true. ! ice thermo (T) or not (F) 33 rn_amax_n = 0.997 ! maximum tolerated ice concentration NH 34 rn_amax_s = 0.997 ! maximum tolerated ice concentration SH 35 cn_icerst_in = "restart_ice" ! suffix of ice restart name (input) 36 cn_icerst_out = "restart_ice" ! suffix of ice restart name (output) 37 cn_icerst_indir = "." ! directory to read input ice restarts 38 cn_icerst_outdir = "." ! directory to write output ice restarts 39 / 40 !------------------------------------------------------------------------------ 41 &namitd ! Ice discretization 42 !------------------------------------------------------------------------------ 43 rn_himean = 2.0 ! expected domain-average ice thickness (m) 44 rn_himin = 0.1 ! minimum ice thickness (m) used in remapping 45 / 46 !------------------------------------------------------------------------------ 47 &namdyn ! Ice dynamics 48 !------------------------------------------------------------------------------ 49 ln_dynFULL = .true. ! dyn.: full ice dynamics (rheology + advection + ridging/rafting + correction) 50 ln_dynRHGADV = .false. ! dyn.: no ridge/raft & no corrections (rheology + advection) 51 ln_dynADV = .false. ! dyn.: only advection w prescribed vel.(rn_uvice + advection) 52 rn_uice = 0.00001 ! prescribed ice u-velocity 53 rn_vice = 0. ! prescribed ice v-velocity 54 rn_ishlat = 2. ! free slip (0) ; partial slip (0-2) ; no slip (2) ; strong slip (>2) 55 ln_landfast = .false. ! landfast ice parameterization (T or F) 56 rn_gamma = 0.15 ! fraction of ocean depth that ice must reach to initiate landfast 57 ! recommended range: [0.1 ; 0.25] 58 rn_icebfr = 10. ! maximum bottom stress per unit area of contact [N/m2] 59 ! a very large value ensures ice velocity=0 even with a small contact area 60 ! recommended range: ?? (should be greater than atm-ice stress => >0.1 N/m2) 61 rn_lfrelax = 1.e-5 ! relaxation time scale to reach static friction [s-1] 62 / 63 !------------------------------------------------------------------------------ 64 &namdyn_rdgrft ! Ice ridging/rafting 65 !------------------------------------------------------------------------------ 66 ! -- ice_rdgrft_strength -- ! 67 ln_str_H79 = .true. ! ice strength param.: Hibler_79 => P = pstar*<h>*exp(-c_rhg*A) 68 rn_pstar = 2.0e+04 ! ice strength thickness parameter [N/m2] 69 rn_crhg = 20.0 ! ice strength conc. parameter (-) 70 ! -- ice_rdgrft -- ! 71 rn_csrdg = 0.5 ! fraction of shearing energy contributing to ridging 72 ! -- ice_rdgrft_prep -- ! 73 ln_partf_lin = .false. ! Linear ridging participation function (Thorndike et al, 1975) 74 rn_gstar = 0.15 ! fractional area of thin ice being ridged 75 ln_partf_exp = .true. ! Exponential ridging participation function (Lipscomb, 2007) 76 rn_astar = 0.03 ! exponential measure of ridging ice fraction [set to 0.05 if hstar=100] 77 ln_ridging = .true. ! ridging activated (T) or not (F) 78 rn_hstar = 25.0 ! determines the maximum thickness of ridged ice [m] (Hibler, 1980) 79 rn_porordg = 0.3 ! porosity of newly ridged ice (Lepparanta et al., 1995) 80 rn_fsnwrdg = 0.5 ! snow volume fraction that survives in ridging 81 rn_fpndrdg = 1.0 ! pond fraction that survives in ridging (small a priori) 82 ln_rafting = .true. ! rafting activated (T) or not (F) 83 rn_hraft = 0.75 ! threshold thickness for rafting [m] 84 rn_craft = 5.0 ! squeezing coefficient used in the rafting function 85 rn_fsnwrft = 0.5 ! snow volume fraction that survives in rafting 86 rn_fpndrft = 1.0 ! pond fraction that survives in rafting (0.5 a priori) 87 / 88 !------------------------------------------------------------------------------ 89 &namdyn_rhg ! Ice rheology 90 !------------------------------------------------------------------------------ 91 ln_rhg_EVP = .true. ! EVP rheology 92 rn_creepl = 1.0e-12 ! creep limit [1/s] 93 rn_ecc = 2.0 ! eccentricity of the elliptical yield curve 94 nn_nevp = 120 ! number of EVP subcycles 95 rn_relast = 0.333 ! ratio of elastic timescale to ice time step: Telast = dt_ice * rn_relast 96 ! advised value: 1/3 (rn_nevp=120) or 1/9 (rn_nevp=300) 97 / 98 !------------------------------------------------------------------------------ 99 &namdyn_adv ! Ice advection 100 !------------------------------------------------------------------------------ 101 ln_adv_Pra = .false. ! Advection scheme (Prather) 102 ln_adv_UMx = .true. ! Advection scheme (Ultimate-Macho) 103 nn_UMx = 5 ! order of the scheme for UMx (1-5 ; 20=centered 2nd order) 104 / 105 !------------------------------------------------------------------------------ 106 &namforcing ! Ice surface forcing 107 !------------------------------------------------------------------------------ 108 rn_cio = 5.0e-03 ! ice-ocean drag coefficient (-) 109 rn_blow_s = 0.66 ! mesure of snow blowing into the leads 110 ! = 1 => no snow blowing, < 1 => some snow blowing 111 nn_iceflx = -1 ! Redistribute heat flux over ice categories 112 ! =-1 Do nothing (needs N(cat) fluxes) 113 ! ==> forced mode only 114 ! = 0 Average N(cat) fluxes then apply the average over the N(cat) ice 115 ! ==> forced and coupled modes 116 ! = 1 Average N(cat) fluxes then redistribute over the N(cat) ice using T-ice and albedo sensitivity 117 ! ==> forced mode only 118 ! = 2 Redistribute a single flux over categories 119 ! ==> coupled mode only 120 / 121 !------------------------------------------------------------------------------ 122 &namthd ! Ice thermodynamics 123 !------------------------------------------------------------------------------ 124 ln_icedH = .true. ! activate ice thickness change from growing/melting (T) or not (F) 125 ln_icedA = .true. ! activate lateral melting param. (T) or not (F) 126 ln_icedO = .true. ! activate ice growth in open-water (T) or not (F) 127 ln_icedS = .true. ! activate gravity drainage and flushing (T) or not (F) 128 / 129 !------------------------------------------------------------------------------ 130 &namthd_zdf ! Ice heat diffusion 131 !------------------------------------------------------------------------------ 132 ln_zdf_BL99 = .true. ! Heat diffusion follows Bitz and Lipscomb 1999 133 ln_cndi_U64 = .false. ! sea ice thermal conductivity: k = k0 + beta.S/T (Untersteiner, 1964) 134 ln_cndi_P07 = .true. ! sea ice thermal conductivity: k = k0 + beta1.S/T - beta2.T (Pringle et al., 2007) 135 rn_cnd_s = 0.31 ! thermal conductivity of the snow (0.31 W/m/K, Maykut and Untersteiner, 1971) 136 ! Obs: 0.1-0.5 (Lecomte et al, JAMES 2013) 137 rn_kappa_i = 1.0 ! radiation attenuation coefficient in sea ice [1/m] 138 ln_dqns_i = .true. ! change the surface non-solar flux with surface temperature (T) or not (F) 139 / 140 !------------------------------------------------------------------------------ 141 &namthd_da ! Ice lateral melting 142 !------------------------------------------------------------------------------ 143 rn_beta = 1.0 ! coef. beta for lateral melting param. Recommended range=[0.8-1.2] 144 ! => decrease = more melt and melt peaks toward higher concentration (A~0.5 for beta=1 ; A~0.8 for beta=0.2) 145 ! 0.3 = best fit for western Fram Strait and Antarctica 146 ! 1.4 = best fit for eastern Fram Strait 147 rn_dmin = 8. ! minimum floe diameter for lateral melting param. Recommended range=[6-10] 148 ! => 6 vs 8m = +40% melting at the peak (A~0.5) 149 ! 10 vs 8m = -20% melting 150 / 151 !------------------------------------------------------------------------------ 152 &namthd_do ! Ice growth in open water 153 !------------------------------------------------------------------------------ 154 rn_hinew = 0.1 ! thickness for new ice formation in open water (m), must be larger than rn_hnewice 155 ln_frazil = .false. ! Frazil ice parameterization (ice collection as a function of wind) 156 rn_maxfraz = 1.0 ! maximum fraction of frazil ice collecting at the ice base 157 rn_vfraz = 0.417 ! thresold drift speed for frazil ice collecting at the ice bottom (m/s) 158 rn_Cfraz = 5.0 ! squeezing coefficient for frazil ice collecting at the ice bottom 159 / 160 !------------------------------------------------------------------------------ 161 &namthd_sal ! Ice salinity 162 !------------------------------------------------------------------------------ 163 nn_icesal = 2 ! ice salinity option 164 ! 1: constant ice salinity (S=rn_icesal) 165 ! 2: varying salinity parameterization S(z,t) 166 ! 3: prescribed salinity profile S(z), Schwarzacher, 1959 167 rn_icesal = 4. ! (nn_icesal=1) ice salinity (g/kg) 168 rn_sal_gd = 5. ! restoring ice salinity, gravity drainage (g/kg) 169 rn_time_gd = 1.73e+6 ! restoring time scale, gravity drainage (s) 170 rn_sal_fl = 2. ! restoring ice salinity, flushing (g/kg) 171 rn_time_fl = 8.64e+5 ! restoring time scale, flushing (s) 172 rn_simax = 20. ! maximum tolerated ice salinity (g/kg) 173 rn_simin = 0.1 ! minimum tolerated ice salinity (g/kg) 174 / 175 !------------------------------------------------------------------------------ 176 &nammp ! Melt ponds 177 !------------------------------------------------------------------------------ 178 ln_pnd = .false. ! active melt ponds 179 ln_pnd_rad = .false. ! active melt ponds radiative coupling 180 ln_pnd_fw = .false. ! active melt ponds freshwater coupling 181 nn_pnd_scheme = 0 ! type of melt pond scheme : =0 prescribed ( Tsu=0 ), =1 empirical, =2 topographic 182 rn_apnd = 0.2 ! prescribed pond fraction, at Tsu=0 : (0<rn_apnd<1, nn_pnd_scheme = 0) 183 rn_hpnd = 0.05 ! prescribed pond depth, at Tsu=0 : (0<rn_apnd<1, nn_pnd_scheme = 0) 184 / 185 !------------------------------------------------------------------------------ 186 &namini ! Ice initialization 187 !------------------------------------------------------------------------------ 188 ln_iceini = .true. ! activate ice initialization (T) or not (F) 189 ln_iceini_file = .false. ! netcdf file provided for initialization (T) or not (F) 190 rn_thres_sst = 2.0 ! max delta temp. above Tfreeze with initial ice = (sst - tfreeze) 191 rn_hts_ini_n = 0.3 ! initial real snow thickness (m), North 192 rn_hts_ini_s = 0.3 ! " " South 193 rn_hti_ini_n = 3.0 ! initial real ice thickness (m), North 194 rn_hti_ini_s = 1.0 ! " " South 195 rn_ati_ini_n = 0.9 ! initial ice concentration (-), North 196 rn_ati_ini_s = 0.9 ! " " South 197 rn_smi_ini_n = 6.3 ! initial ice salinity (g/kg), North 198 rn_smi_ini_s = 6.3 ! " " South 199 rn_tmi_ini_n = 270. ! initial ice/snw temperature (K), North 200 rn_tmi_ini_s = 270. ! " " South 201 202 sn_hti = 'Ice_initialization' , -12 ,'hti' , .false. , .true., 'yearly' , '' , '', '' 203 sn_hts = 'Ice_initialization' , -12 ,'hts' , .false. , .true., 'yearly' , '' , '', '' 204 sn_ati = 'Ice_initialization' , -12 ,'ati' , .false. , .true., 'yearly' , '' , '', '' 205 sn_tsu = 'Ice_initialization' , -12 ,'tsu' , .false. , .true., 'yearly' , '' , '', '' 206 sn_tmi = 'Ice_initialization' , -12 ,'tmi' , .false. , .true., 'yearly' , '' , '', '' 207 sn_smi = 'Ice_initialization' , -12 ,'smi' , .false. , .true., 'yearly' , '' , '', '' 208 cn_dir='./' 209 / 210 !------------------------------------------------------------------------------ 211 &namalb ! albedo parameters 212 !------------------------------------------------------------------------------ 213 nn_ice_alb = 1 ! parameterization of ice/snow albedo 214 ! 0: Shine & Henderson-Sellers (JGR 1985), giving clear-sky albedo 215 ! 1: "home made" based on Brandt et al. (JClim 2005) 216 ! and Grenfell & Perovich (JGR 2004), giving cloud-sky albedo 217 ! 2: as 1 with melt ponds 218 rn_alb_sdry = 0.85 ! dry snow albedo : 0.80 (nn_ice_alb = 0); 0.85 (nn_ice_alb = 1); obs 0.85-0.87 (cloud-sky) 219 rn_alb_smlt = 0.75 ! melting snow albedo : 0.65 ( '' ) ; 0.75 ( '' ) ; obs 0.72-0.82 ( '' ) 220 rn_alb_idry = 0.60 ! dry ice albedo : 0.72 ( '' ) ; 0.60 ( '' ) ; obs 0.54-0.65 ( '' ) 221 rn_alb_imlt = 0.50 ! bare puddled ice albedo : 0.53 ( '' ) ; 0.50 ( '' ) ; obs 0.49-0.58 ( '' ) 222 rn_alb_dpnd = 0.27 ! ponded ice albedo : 0.25 ( '' ) ; 0.27 ( '' ) ; obs 0.10-0.30 ( '' ) 223 / 224 !------------------------------------------------------------------------------ 225 &namdia ! Diagnostics 226 !------------------------------------------------------------------------------ 227 ln_icediachk = .false. ! check online the heat, mass & salt budgets (T) or not (F) 228 ln_icediahsb = .false. ! output the heat, mass & salt budgets (T) or not (F) 229 ln_icectl = .false. ! ice points output for debug (T or F) 230 iiceprt = 10 ! i-index for debug 231 jiceprt = 10 ! j-index for debug 232 / -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/SHARED/namelist_ref
r8733 r8738 192 192 ! =1 opa-sas OASIS coupling: multi executable configuration, OPA component 193 193 ! =2 opa-sas OASIS coupling: multi executable configuration, SAS component 194 nn_limflx = -1 ! LIM3 Multi-category heat flux formulation (use -1 if LIM3 is not used)195 ! =-1 Use per-category fluxes, bypass redistributor, forced mode only, not yet implemented coupled196 ! = 0 Average per-category fluxes (forced and coupled mode)197 ! = 1 Average and redistribute per-category fluxes, forced mode only, not yet implemented coupled198 ! = 2 Redistribute a single flux over categories (coupled mode only)199 194 ! Sea-ice : 200 nn_ice = 3! =0 no ice boundary condition ,195 nn_ice = 2 ! =0 no ice boundary condition , 201 196 ! =1 use observed ice-cover , 202 ! =2 to 4 : ice-model used (LIM2, LIM3 or CICE) ("key_lim3", "key_lim2", or "key_cice") 203 nn_ice_embd = 1 ! =0 levitating ice (no mass exchange, concentration/dilution effect) 204 ! =1 levitating ice with mass and salt exchange but no presure effect 205 ! =2 embedded sea-ice (full salt and mass exchanges and pressure) 197 ! =2 & 3 : ice-model used (LIM3 or CICE) ("key_lim3" or "key_cice") 198 ln_ice_embd = .false. ! =F levitating ice with mass and salt exchange but no presure effect 199 ! =T embedded sea-ice (full salt and mass exchanges and pressure) 206 200 ! Misc. options of sbc : 207 201 ln_traqsr = .true. ! Light penetration in the ocean (T => fill namtra_qsr) … … 264 258 rn_vfac = 0. ! multiplicative factor for ocean/ice velocity 265 259 ! in the calculation of the wind stress (0.=absolute winds or 1.=relative winds) 266 ln_Cd_L12 = .false. ! Modify the drag ice-atm and oce-atm depending on ice concentration267 ! This parameterization is from Lupkes et al. (JGR 2012)260 ln_Cd_L12 = .false. ! Modify the drag ice-atm depending on ice concentration with Lupkes 2012 261 ln_Cd_L15 = .false. ! Modify the drag ice-atm depending on ice concentration with Lupkes 2015 268 262 / 269 263 !----------------------------------------------------------------------- … … 313 307 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename ! 314 308 l_sasread = .TRUE. ! Read fields in a file if .TRUE. , or initialize to 0. in sbcssm.F90 if .FALSE. 315 sn_usp = 'sas_grid_U', 120 , 'vozocrtx', .true. , .true. , 'yearly' , '' , '' , ''316 sn_vsp = 'sas_grid_V', 120 , 'vomecrty', .true. , .true. , 'yearly' , '' , '' , ''309 sn_usp = 'sas_grid_U', 120 , 'uos' , .true. , .true. , 'yearly' , '' , '' , '' 310 sn_vsp = 'sas_grid_V', 120 , 'vos' , .true. , .true. , 'yearly' , '' , '' , '' 317 311 sn_tem = 'sas_grid_T', 120 , 'sosstsst', .true. , .true. , 'yearly' , '' , '' , '' 318 312 sn_sal = 'sas_grid_T', 120 , 'sosaline', .true. , .true. , 'yearly' , '' , '' , '' … … 321 315 sn_frq = 'sas_grid_T', 120 , 'frq_m' , .true. , .true. , 'yearly' , '' , '' , '' 322 316 323 ln_3d_uve = . true.! specify whether we are supplying a 3D u,v and e3 field317 ln_3d_uve = .false. ! specify whether we are supplying a 3D u,v and e3 field 324 318 ln_read_frq = .false. ! specify whether we must read frq or not 325 319 cn_dir = './' ! root directory for the location of the bulk files are … … 340 334 rn_si0 = 0.35 ! RGB & 2 bands: shortess depth of extinction 341 335 rn_si1 = 23.0 ! 2 bands: longest depth of extinction 342 ln_qsr_ice = .true. ! light penetration for ice-model LIM3343 336 / 344 337 !----------------------------------------------------------------------- … … 434 427 ln_sssr_bnd = .true. ! flag to bound erp term (associated with nn_sssr=2) 435 428 rn_sssr_bnd = 4.e0 ! ABS(Max/Min) value of the damping erp term [mm/day] 436 /437 !-----------------------------------------------------------------------438 &namsbc_alb ! albedo parameters439 !-----------------------------------------------------------------------440 nn_ice_alb = 1 ! parameterization of ice/snow albedo441 ! 0: Shine & Henderson-Sellers (JGR 1985), giving clear-sky albedo442 ! 1: "home made" based on Brandt et al. (JClim 2005) and Grenfell & Perovich (JGR 2004),443 ! giving cloud-sky albedo444 rn_alb_sdry = 0.85 ! dry snow albedo : 0.80 (nn_ice_alb = 0); 0.85 (nn_ice_alb = 1); obs 0.85-0.87 (cloud-sky)445 rn_alb_smlt = 0.75 ! melting snow albedo : 0.65 ( '' ) ; 0.75 ( '' ) ; obs 0.72-0.82 ( '' )446 rn_alb_idry = 0.60 ! dry ice albedo : 0.72 ( '' ) ; 0.60 ( '' ) ; obs 0.54-0.65 ( '' )447 rn_alb_imlt = 0.50 ! bare puddled ice albedo : 0.53 ( '' ) ; 0.50 ( '' ) ; obs 0.49-0.58 ( '' )448 429 / 449 430 !----------------------------------------------------------------------- … … 581 562 bn_tem = 'amm12_bdyT_tra', 24 , 'votemper', .true. , .false. , 'daily' , '' , '' , '' 582 563 bn_sal = 'amm12_bdyT_tra', 24 , 'vosaline', .true. , .false. , 'daily' , '' , '' , '' 583 ! for lim2584 ! bn_frld = 'amm12_bdyT_ice', 24 , 'ileadfra', .true. , .false. , 'daily' , '' , '' , ''585 ! bn_hicif = 'amm12_bdyT_ice', 24 , 'iicethic', .true. , .false. , 'daily' , '' , '' , ''586 ! bn_hsnif = 'amm12_bdyT_ice', 24 , 'isnowthi', .true. , .false. , 'daily' , '' , '' , ''587 564 ! for lim3 588 565 ! bn_a_i = 'amm12_bdyT_ice', 24 , 'ileadfra', .true. , .false. , 'daily' , '' , '' , '' 589 ! bn_h t_i = 'amm12_bdyT_ice', 24 , 'iicethic', .true. , .false. , 'daily' , '' , '' , ''590 ! bn_h t_s = 'amm12_bdyT_ice', 24 , 'isnowthi', .true. , .false. , 'daily' , '' , '' , ''566 ! bn_h_i = 'amm12_bdyT_ice', 24 , 'iicethic', .true. , .false. , 'daily' , '' , '' , '' 567 ! bn_h_s = 'amm12_bdyT_ice', 24 , 'isnowthi', .true. , .false. , 'daily' , '' , '' , '' 591 568 592 569 cn_dir = 'bdydta/' ! root directory for the location of the bulk files -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/ISOMIP/EXP00/namelist_cfg
r8018 r8738 64 64 ! =1 use observed ice-cover , 65 65 ! =2 ice-model used 66 nn_ice_embd = 0 ! =0 levitating ice (no mass exchange, concentration/dilution effect)67 ! = 1 levitating ice with mass and salt exchange but no presure effect68 ! =2 embedded sea-ice (full salt and mass exchanges and pressure)66 ln_ice_embd = .false. ! =F levitating ice with mass and salt exchange but no presure effect 67 ! =T embedded sea-ice (full salt and mass exchanges and pressure) 68 ! Misc. options of sbc : 69 69 ln_traqsr = .false. ! Light penetration (T) or not (F) 70 70 ln_rnf = .false. ! runoffs (T => fill namsbc_rnf) -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/namelist_cfg
r7822 r8738 26 26 &namdom ! space and time domain (bathymetry, mesh, timestep) 27 27 !----------------------------------------------------------------------- 28 ln_linssh = . false. ! =T linear free surface ==>> model level are fixed in time28 ln_linssh = .true. ! =T linear free surface ==>> model level are fixed in time 29 29 ! 30 30 nn_msh = 1 ! create (>0) a mesh file or not (=0) -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/SAS_BIPER/EXP00/namelist_ice_cfg
r7820 r8738 6 6 !! 4 - Ice discretization (namiceitd) 7 7 !! 5 - Ice dynamics and transport (namicedyn) 8 !! 6 - Ice diffusion (namicehdf)9 !! 7 - Ice thermodynamics (namicethd)10 !! 8 - Ice salinity (namicesal)11 !! 9 - Ice mechanical redistribution (namiceitdme)8 !! 6 - Ice thermodynamics (namicethd) 9 !! 7 - Ice salinity (namicesal) 10 !! 8 - Ice mechanical redistribution (namiceitdme) 11 !! 9 - Ice/snow albedos (namicealb) 12 12 !!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 13 13 ! … … 56 56 / 57 57 !------------------------------------------------------------------------------ 58 &namicehdf ! Ice horizontal diffusion59 !------------------------------------------------------------------------------60 /61 !------------------------------------------------------------------------------62 58 &namicethd ! Ice thermodynamics 63 59 !------------------------------------------------------------------------------ … … 85 81 ln_rafting = .true. ! rafting activated (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 86 82 / 83 !----------------------------------------------------------------------- 84 &namicealb ! albedo parameters 85 !----------------------------------------------------------------------- 86 / -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/bdyini.F90
r8733 r8738 351 351 IF(lwp) WRITE(numout,*) 352 352 353 #if defined key_lim2 354 IF(lwp) WRITE(numout,*) 'Boundary conditions for sea ice: ' 355 SELECT CASE( cn_ice_lim(ib_bdy) ) 356 CASE('none') 357 IF(lwp) WRITE(numout,*) ' no open boundary condition' 358 dta_bdy(ib_bdy)%ll_frld = .false. 359 dta_bdy(ib_bdy)%ll_hicif = .false. 360 dta_bdy(ib_bdy)%ll_hsnif = .false. 361 CASE('frs') 362 IF(lwp) WRITE(numout,*) ' Flow Relaxation Scheme' 363 dta_bdy(ib_bdy)%ll_frld = .true. 364 dta_bdy(ib_bdy)%ll_hicif = .true. 365 dta_bdy(ib_bdy)%ll_hsnif = .true. 366 CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for cn_ice_lim' ) 367 END SELECT 368 IF( cn_ice_lim(ib_bdy) /= 'none' ) THEN 369 SELECT CASE( nn_ice_lim_dta(ib_bdy) ) ! 370 CASE( 0 ) ; IF(lwp) WRITE(numout,*) ' initial state used for bdy data' 371 CASE( 1 ) ; IF(lwp) WRITE(numout,*) ' boundary data taken from file' 372 CASE DEFAULT ; CALL ctl_stop( 'nn_ice_lim_dta must be 0 or 1' ) 373 END SELECT 374 ENDIF 375 IF(lwp) WRITE(numout,*) 376 #elif defined key_lim3 353 #if defined key_lim3 377 354 IF(lwp) WRITE(numout,*) 'Boundary conditions for sea ice: ' 378 355 SELECT CASE( cn_ice_lim(ib_bdy) ) -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/EXTERNAL/AGRIF/LIB/decl.h
r8733 r8738 36 36 #define LONG_FNAME 1000 // Max length for a file name 37 37 #define LONG_C 200 38 #define LONG_M 150038 #define LONG_M 2000 39 39 40 40 #define NB_CAT_VARIABLES 5 -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/LIM_SRC_3/ice.F90
r8733 r8738 1 1 MODULE ice 2 2 !!====================================================================== 3 !! *** MODULE ice ***4 !! LIM-3 Sea Ice physics: diagnostics variables of icedefined in memory5 !!===================================================================== 3 !! *** MODULE ice *** 4 !! sea-ice: ice variables defined in memory 5 !!====================================================================== 6 6 !! History : 3.0 ! 2008-03 (M. Vancoppenolle) original code LIM-3 7 7 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation … … 9 9 #if defined key_lim3 10 10 !!---------------------------------------------------------------------- 11 !! 'key_lim3' LIM-3sea-ice model11 !! 'key_lim3' ESIM sea-ice model 12 12 !!---------------------------------------------------------------------- 13 13 USE in_out_manager ! I/O manager … … 17 17 PRIVATE 18 18 19 PUBLIC ice_alloc ! Called in sbc_lim_init19 PUBLIC ice_alloc ! called by icestp.F90 20 20 21 21 !!====================================================================== … … 63 63 !! meaningful and/or used in ice thermodynamics | 64 64 !! | 65 !! Routines in limvar.F90 perform conversions |66 !! - lim_var_glo2eqv : from global to equivalent variables |67 !! - lim_var_eqv2glo : from equivalent to global variables |65 !! Routines in icevar.F90 perform conversions | 66 !! - ice_var_glo2eqv : from global to equivalent variables | 67 !! - ice_var_eqv2glo : from equivalent to global variables | 68 68 !! | 69 69 !! For various purposes, the sea ice state variables have sometimes | 70 70 !! to be aggregated over all ice thickness categories. This operation | 71 71 !! is done in : | 72 !! - lim_var_agg |72 !! - ice_var_agg | 73 73 !! | 74 74 !! in icestp.F90, the routines that compute the changes in the ice | 75 75 !! state variables are called | 76 !! - lim_dyn : ice dynamics | 77 !! - lim_trp : ice transport | 78 !! - lim_itd_me : mechanical redistribution (ridging and rafting) | 79 !! - lim_thd : ice halo-thermodynamics | 80 !! - lim_itd_th : thermodynamic changes in ice thickness distribution | 81 !! and creation of new ice | 76 !! - ice_rhg : ice dynamics | 77 !! - ice_adv : ice advection | 78 !! - ice_rdgrft : ice ridging and rafting | 79 !! - ice_thd : ice halo-thermodynamics and creation of new ice | 80 !! - ice_itd : thermodynamic changes in ice thickness distribution | 82 81 !! | 83 82 !! See the associated routines for more information | … … 107 106 !! v_i | - | Ice volume per unit area | m | 108 107 !! v_s | - | Snow volume per unit area | m | 109 !! s mv_i| - | Sea ice salt content | ppt.m |110 !! oa_i ! - ! Sea ice areal age content | day|108 !! sv_i | - | Sea ice salt content | ppt.m | 109 !! oa_i ! - ! Sea ice areal age content | s | 111 110 !! e_i ! - ! Ice enthalpy | J/m2 | 112 !! - ! q_i_1d ! Ice enthalpy per unit vol. | J/m3 |111 !! - ! e_i_1d ! Ice enthalpy per unit vol. | J/m3 | 113 112 !! e_s ! - ! Snow enthalpy | J/m2 | 114 !! - ! q_s_1d ! Snow enthalpy per unit vol. | J/m3 |113 !! - ! e_s_1d ! Snow enthalpy per unit vol. | J/m3 | 115 114 !! | 116 115 !!-------------|-------------|---------------------------------|-------| … … 119 118 !!-------------|-------------|---------------------------------|-------| 120 119 !! | 121 !! h t_i | ht_i_1d| Ice thickness | m |122 !! h t_s ! ht_s_1d| Snow depth | m |123 !! s m_i ! sm_i_1d| Sea ice bulk salinity ! ppt |124 !! s _i ! s_i_1d| Sea ice salinity profile ! ppt |125 !! o_i ! - | Sea ice Age ! days|120 !! h_i | h_i_1d | Ice thickness | m | 121 !! h_s ! h_s_1d | Snow depth | m | 122 !! s_i ! s_i_1d | Sea ice bulk salinity ! ppt | 123 !! sz_i ! sz_i_1d | Sea ice salinity profile ! ppt | 124 !! o_i ! - | Sea ice Age ! s | 126 125 !! t_i ! t_i_1d | Sea ice temperature ! K | 127 126 !! t_s ! t_s_1d | Snow temperature ! K | … … 144 143 !! vt_i | - | Total ice vol. per unit area | m | 145 144 !! vt_s | - | Total snow vol. per unit ar. | m | 146 !! sm t_i| - | Mean sea ice salinity | ppt |145 !! sm_i | - | Mean sea ice salinity | ppt | 147 146 !! tm_i | - | Mean sea ice temperature | K | 148 147 !! et_i ! - ! Total ice enthalpy | J/m2 | … … 151 150 !!===================================================================== 152 151 153 LOGICAL, PUBLIC :: con_i = .false. ! switch for conservation test 154 155 !!-------------------------------------------------------------------------- 152 !!---------------------------------------------------------------------- 156 153 !! * Share Module variables 157 !!---------------------------------------------------------------------- ----158 ! !!** ice-generic parameters namelist (nam icerun) **154 !!---------------------------------------------------------------------- 155 ! !!** ice-generic parameters namelist (nampar) ** 159 156 INTEGER , PUBLIC :: jpl !: number of ice categories 160 157 INTEGER , PUBLIC :: nlay_i !: number of ice layers 161 158 INTEGER , PUBLIC :: nlay_s !: number of snow layers 159 INTEGER , PUBLIC :: nn_monocat !: virtual ITD mono-category parameterizations (1-4) or not (0) 160 LOGICAL , PUBLIC :: ln_icedyn !: flag for ice dynamics (T) or not (F) 161 LOGICAL , PUBLIC :: ln_icethd !: flag for ice thermo (T) or not (F) 162 162 REAL(wp) , PUBLIC :: rn_amax_n !: maximum ice concentration Northern hemisphere 163 163 REAL(wp) , PUBLIC :: rn_amax_s !: maximum ice concentration Southern hemisphere … … 166 166 CHARACTER(len=256), PUBLIC :: cn_icerst_indir !: ice restart input directory 167 167 CHARACTER(len=256), PUBLIC :: cn_icerst_outdir!: ice restart output directory 168 LOGICAL , PUBLIC :: ln_limthd !: flag for ice thermo (T) or not (F) 169 LOGICAL , PUBLIC :: ln_limdyn !: flag for ice dynamics (T) or not (F) 170 INTEGER , PUBLIC :: nn_limdyn !: flag for ice dynamics 171 REAL(wp) , PUBLIC :: rn_uice !: prescribed u-vel (case nn_limdyn=0) 172 REAL(wp) , PUBLIC :: rn_vice !: prescribed v-vel (case nn_limdyn=0) 168 169 ! !!** ice-itd namelist (namitd) ** 170 REAL(wp), PUBLIC :: rn_himin !: minimum ice thickness 173 171 174 ! !!** ice-diagnostics namelist (namicediag) ** 175 LOGICAL , PUBLIC :: ln_limdiachk !: flag for ice diag (T) or not (F) 176 LOGICAL , PUBLIC :: ln_limdiahsb !: flag for ice diag (T) or not (F) 177 LOGICAL , PUBLIC :: ln_limctl !: flag for sea-ice points output (T) or not (F) 178 INTEGER , PUBLIC :: iiceprt !: debug i-point 179 INTEGER , PUBLIC :: jiceprt !: debug j-point 180 181 ! !!** ice-init namelist (namiceini) ** 182 ! -- limistate -- ! 183 LOGICAL , PUBLIC :: ln_limini ! initialization or not 184 LOGICAL , PUBLIC :: ln_limini_file ! Ice initialization state from 2D netcdf file 185 REAL(wp), PUBLIC :: rn_thres_sst ! threshold water temperature for initial sea ice 186 REAL(wp), PUBLIC :: rn_hts_ini_n ! initial snow thickness in the north 187 REAL(wp), PUBLIC :: rn_hts_ini_s ! initial snow thickness in the south 188 REAL(wp), PUBLIC :: rn_hti_ini_n ! initial ice thickness in the north 189 REAL(wp), PUBLIC :: rn_hti_ini_s ! initial ice thickness in the south 190 REAL(wp), PUBLIC :: rn_ati_ini_n ! initial leads area in the north 191 REAL(wp), PUBLIC :: rn_ati_ini_s ! initial leads area in the south 192 REAL(wp), PUBLIC :: rn_smi_ini_n ! initial salinity 193 REAL(wp), PUBLIC :: rn_smi_ini_s ! initial salinity 194 REAL(wp), PUBLIC :: rn_tmi_ini_n ! initial temperature 195 REAL(wp), PUBLIC :: rn_tmi_ini_s ! initial temperature 196 197 ! !!** ice-thickness distribution namelist (namiceitd) ** 198 INTEGER , PUBLIC :: nn_catbnd !: categories distribution following: tanh function (1), or h^(-alpha) function (2) 199 REAL(wp), PUBLIC :: rn_himean !: mean thickness of the domain (used to compute the distribution, nn_itdshp = 2 only) 200 201 ! !!** ice-dynamics namelist (namicedyn) ** 202 ! -- limtrp & limadv -- ! 203 INTEGER , PUBLIC :: nn_limadv !: choose the advection scheme (-1=Prather ; 0=Ultimate-Macho) 204 INTEGER , PUBLIC :: nn_limadv_ord !: choose the order of the advection scheme (if Ultimate-Macho) 205 ! -- limitd_me -- ! 206 INTEGER , PUBLIC :: nn_icestr !: ice strength parameterization (0=Hibler79 1=Rothrock75) 207 REAL(wp), PUBLIC :: rn_pe_rdg !: ridging work divided by pot. energy change in ridging, nn_icestr = 1 208 REAL(wp), PUBLIC :: rn_pstar !: determines ice strength, Hibler JPO79 209 REAL(wp), PUBLIC :: rn_crhg !: determines changes in ice strength 210 LOGICAL , PUBLIC :: ln_icestr_bvf !: use brine volume to diminish ice strength 211 ! -- limdyn & limrhg -- ! 212 REAL(wp), PUBLIC :: rn_cio !: drag coefficient for oceanic stress 172 ! !!** ice-dynamics namelist (namdyn) ** 173 REAL(wp), PUBLIC :: rn_ishlat !: lateral boundary condition for sea-ice 174 LOGICAL , PUBLIC :: ln_landfast !: landfast ice parameterization (T or F) 175 REAL(wp), PUBLIC :: rn_gamma !: fraction of ocean depth that ice must reach to initiate landfast ice 176 REAL(wp), PUBLIC :: rn_icebfr !: maximum bottom stress per unit area of contact (landfast ice) 177 REAL(wp), PUBLIC :: rn_lfrelax !: relaxation time scale (s-1) to reach static friction (landfast ice) 178 ! 179 ! !!** ice-rheology namelist (namrhg) ** 213 180 REAL(wp), PUBLIC :: rn_creepl !: creep limit : has to be under 1.0e-9 214 181 REAL(wp), PUBLIC :: rn_ecc !: eccentricity of the elliptical yield curve 215 182 INTEGER , PUBLIC :: nn_nevp !: number of iterations for subcycling 216 183 REAL(wp), PUBLIC :: rn_relast !: ratio => telast/rdt_ice (1/3 or 1/9 depending on nb of subcycling nevp) 217 LOGICAL , PUBLIC :: ln_landfast !: landfast ice parameterization (T or F) 218 REAL(wp), PUBLIC :: rn_gamma !: fraction of ocean depth that ice must reach to initiate landfast ice 219 REAL(wp), PUBLIC :: rn_icebfr !: maximum bottom stress per unit area of contact (landfast ice) 220 REAL(wp), PUBLIC :: rn_lfrelax !: relaxation time scale (s-1) to reach static friction (landfast ice) 221 222 ! !!** ice-diffusion namelist (namicehdf) ** 223 INTEGER , PUBLIC :: nn_ahi0 !: sea-ice hor. eddy diffusivity coeff. (3 ways of calculation) 224 REAL(wp), PUBLIC :: rn_ahi0_ref !: sea-ice hor. eddy diffusivity coeff. (m2/s) 225 226 ! !!** ice-thermodynamics namelist (namicethd) ** 227 ! -- limthd_dif -- ! 228 REAL(wp), PUBLIC :: rn_kappa_i !: coef. for the extinction of radiation Grenfell et al. (2006) [1/m] 229 REAL(wp), PUBLIC :: nn_conv_dif !: maximal number of iterations for heat diffusion 230 REAL(wp), PUBLIC :: rn_terr_dif !: maximal tolerated error (C) for heat diffusion 231 INTEGER , PUBLIC :: nn_ice_thcon !: thermal conductivity: =0 Untersteiner (1964) ; =1 Pringle et al (2007) 232 LOGICAL , PUBLIC :: ln_it_qnsice !: iterate surface flux with changing surface temperature or not (F) 233 INTEGER , PUBLIC :: nn_monocat !: virtual ITD mono-category parameterizations (1) or not (0) 234 REAL(wp), PUBLIC :: rn_cdsn !: thermal conductivity of the snow [W/m/K] 235 ! -- limthd_dh -- ! 236 LOGICAL , PUBLIC :: ln_limdH !: activate ice thickness change from growing/melting (T) or not (F) 237 REAL(wp), PUBLIC :: rn_betas !: coef. for partitioning of snowfall between leads and sea ice 238 ! -- limthd_da -- ! 239 LOGICAL , PUBLIC :: ln_limdA !: activate lateral melting param. (T) or not (F) 240 REAL(wp), PUBLIC :: rn_beta !: coef. beta for lateral melting param. 241 REAL(wp), PUBLIC :: rn_dmin !: minimum floe diameter for lateral melting param. 242 ! -- limthd_lac -- ! 243 LOGICAL , PUBLIC :: ln_limdO !: activate ice growth in open-water (T) or not (F) 244 REAL(wp), PUBLIC :: rn_hnewice !: thickness for new ice formation (m) 245 LOGICAL , PUBLIC :: ln_frazil !: use of frazil ice collection as function of wind (T) or not (F) 246 REAL(wp), PUBLIC :: rn_maxfrazb !: maximum portion of frazil ice collecting at the ice bottom 247 REAL(wp), PUBLIC :: rn_vfrazb !: threshold drift speed for collection of bottom frazil ice 248 REAL(wp), PUBLIC :: rn_Cfrazb !: squeezing coefficient for collection of bottom frazil ice 249 ! -- limitd_th -- ! 250 REAL(wp), PUBLIC :: rn_himin !: minimum ice thickness 251 252 ! !!** ice-salinity namelist (namicesal) ** 253 LOGICAL , PUBLIC :: ln_limdS !: activate gravity drainage and flushing (T) or not (F) 184 ! 185 ! !!** ice-surface forcing namelist (namforcing) ** 186 ! -- icethd_dh -- ! 187 REAL(wp), PUBLIC :: rn_blow_s !: coef. for partitioning of snowfall between leads and sea ice 188 ! -- icethd -- ! 189 REAL(wp), PUBLIC :: rn_cio !: drag coefficient for oceanic stress 190 INTEGER , PUBLIC :: nn_iceflx !: Redistribute heat flux over ice categories 191 ! ! =-1 Do nothing (needs N(cat) fluxes) 192 ! ! = 0 Average N(cat) fluxes then apply the average over the N(cat) ice 193 ! ! = 1 Average N(cat) fluxes then redistribute over the N(cat) ice 194 ! ! using T-ice and albedo sensitivity 195 ! ! = 2 Redistribute a single flux over categories 196 197 ! !!** ice-salinity namelist (namthd_sal) ** 254 198 INTEGER , PUBLIC :: nn_icesal !: salinity configuration used in the model 255 199 ! ! 1 - constant salinity in both space and time … … 257 201 ! ! 3 - salinity profile, constant in time 258 202 REAL(wp), PUBLIC :: rn_icesal !: bulk salinity (ppt) in case of constant salinity 259 REAL(wp), PUBLIC :: rn_sal_gd !: restoring salinity for gravity drainage [PSU]260 REAL(wp), PUBLIC :: rn_time_gd !: restoring time constant for gravity drainage (= 20 days) [s]261 REAL(wp), PUBLIC :: rn_sal_fl !: restoring salinity for flushing [PSU]262 REAL(wp), PUBLIC :: rn_time_fl !: restoring time constant for gravity drainage (= 10 days) [s]263 203 REAL(wp), PUBLIC :: rn_simax !: maximum ice salinity [PSU] 264 204 REAL(wp), PUBLIC :: rn_simin !: minimum ice salinity [PSU] 265 205 266 ! !!** ice-mechanical redistribution namelist (namiceitdme) 267 REAL(wp), PUBLIC :: rn_cs !: fraction of shearing energy contributing to ridging 268 INTEGER , PUBLIC :: nn_partfun !: participation function: =0 Thorndike et al. (1975), =1 Lipscomb et al. (2007) 269 REAL(wp), PUBLIC :: rn_gstar !: fractional area of young ice contributing to ridging 270 REAL(wp), PUBLIC :: rn_astar !: equivalent of G* for an exponential participation function 271 LOGICAL , PUBLIC :: ln_ridging !: ridging of ice or not 272 REAL(wp), PUBLIC :: rn_hstar !: thickness that determines the maximal thickness of ridged ice 273 REAL(wp), PUBLIC :: rn_por_rdg !: initial porosity of ridges (0.3 regular value) 274 REAL(wp), PUBLIC :: rn_fsnowrdg !: fractional snow loss to the ocean during ridging 275 LOGICAL , PUBLIC :: ln_rafting !: rafting of ice or not 276 REAL(wp), PUBLIC :: rn_hraft !: threshold thickness (m) for rafting / ridging 277 REAL(wp), PUBLIC :: rn_craft !: coefficient for smoothness of the hyperbolic tangent in rafting 278 REAL(wp), PUBLIC :: rn_fsnowrft !: fractional snow loss to the ocean during ridging 206 ! MV MP 2016 207 ! !!** melt pond namelist (nammp) 208 LOGICAL , PUBLIC :: ln_pnd !: activate ponds or not 209 LOGICAL , PUBLIC :: ln_pnd_rad !: ponds radiatively active or not 210 LOGICAL , PUBLIC :: ln_pnd_fw !: ponds active wrt meltwater or not 211 INTEGER , PUBLIC :: nn_pnd_scheme !: type of melt pond scheme: =0 prescribed, =1 empirical, =2 topographic 212 REAL(wp), PUBLIC :: rn_apnd !: prescribed pond fraction (0<rn_apnd<1), only if nn_pnd_scheme = 0 213 REAL(wp), PUBLIC :: rn_hpnd !: prescribed pond depth (0<rn_hpnd<1), only if nn_pnd_scheme = 0 214 ! END MV MP 2016 215 ! !!** ice-diagnostics namelist (namdia) ** 216 LOGICAL , PUBLIC :: ln_icediachk !: flag for ice diag (T) or not (F) 217 LOGICAL , PUBLIC :: ln_icediahsb !: flag for ice diag (T) or not (F) 218 LOGICAL , PUBLIC :: ln_icectl !: flag for sea-ice points output (T) or not (F) 219 INTEGER , PUBLIC :: iiceprt !: debug i-point 220 INTEGER , PUBLIC :: jiceprt !: debug j-point 279 221 280 222 ! !!** some other parameters 281 INTEGER , PUBLIC :: nstart !: iteration number of the begining of the run 282 INTEGER , PUBLIC :: nlast !: iteration number of the end of the run 283 INTEGER , PUBLIC :: nitrun !: number of iteration 284 INTEGER , PUBLIC :: numit !: iteration number 223 INTEGER , PUBLIC :: kt_ice !: iteration number 285 224 REAL(wp), PUBLIC :: rdt_ice !: ice time step 286 225 REAL(wp), PUBLIC :: r1_rdtice !: = 1. / rdt_ice … … 288 227 REAL(wp), PUBLIC :: r1_nlay_s !: 1 / nlay_s 289 228 REAL(wp), PUBLIC :: rswitch !: switch for the presence of ice (1) or not (0) 290 REAL(wp), PUBLIC, PARAMETER :: epsi06 = 1.e-06_wp !: small number 291 REAL(wp), PUBLIC, PARAMETER :: epsi10 = 1.e-10_wp !: small number 292 REAL(wp), PUBLIC, PARAMETER :: epsi20 = 1.e-20_wp !: small number 229 REAL(wp), PUBLIC :: rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft !: conservation diagnostics 230 REAL(wp), PUBLIC, PARAMETER :: epsi06 = 1.e-06_wp !: small number 231 REAL(wp), PUBLIC, PARAMETER :: epsi10 = 1.e-10_wp !: small number 232 REAL(wp), PUBLIC, PARAMETER :: epsi20 = 1.e-20_wp !: small number 233 293 234 294 235 ! !!** define arrays 295 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_oce, v_oce !: surface ocean velocity used in ice dynamics 296 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahiu , ahiv !: hor. diffusivity coeff. at U- and V-points [m2/s] 297 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hicol !: ice collection thickness accreted in leads 236 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_oce,v_oce !: surface ocean velocity used in ice dynamics 237 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht_i_new !: ice collection thickness accreted in leads 298 238 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: strength !: ice strength 299 239 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: stress1_i, stress2_i, stress12_i !: 1st, 2nd & diagonal stress tensor element … … 303 243 ! 304 244 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_bo !: Sea-Ice bottom temperature [Kelvin] 305 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: frld !: Leads fraction = 1 - ice fraction306 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: pfrld !: Leads fraction at previous time307 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: phicif !: Old ice thickness308 245 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qlead !: heat balance of the lead (or of the open ocean) 309 246 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fhtur !: net downward heat flux from the ice to the ocean … … 311 248 312 249 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_snw !: snow-ocean mass exchange [kg.m-2.s-1] 250 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_snw_sni !: snow ice growth component of wfx_snw [kg.m-2.s-1] 251 ! MV MP 2016 252 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_snw_sum !: surface melt component of wfx_snw [kg.m-2.s-1] 253 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_pnd !: melt pond-ocean mass exchange [kg.m-2.s-1] 254 ! END MV MP 2016 313 255 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_spr !: snow precipitation on ice [kg.m-2.s-1] 314 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sub !: snow/ice sublimation [kg.m-2.s-1] 256 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_sub !: sublimation of snow/ice [kg.m-2.s-1] 257 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_snw_sub !: snow sublimation [kg.m-2.s-1] 258 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_ice_sub !: ice sublimation [kg.m-2.s-1] 259 260 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_snw_dyn !: dynamical component of wfx_snw [kg.m-2.s-1] 315 261 316 262 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wfx_ice !: ice-ocean mass exchange [kg.m-2.s-1] … … 325 271 326 272 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: afx_tot !: ice concentration tendency (total) [s-1] 327 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: afx_thd !: ice concentration tendency (thermodynamics) [s-1]328 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: afx_dyn !: ice concentration tendency (dynamics) [s-1]329 273 330 274 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx_bog !: salt flux due to ice growth/melt [PSU/m2/s] … … 346 290 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_dif !: total heat flux causing Temp change in the ice [W.m-2] 347 291 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_snw !: heat flux for snow melt [W.m-2] 348 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_err !: heat flux error after heat diffusion [W.m-2]349 292 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_err_dif !: heat flux remaining due to change in non-solar flux [W.m-2] 350 293 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_err_rem !: heat flux error after heat remapping [W.m-2] … … 358 301 359 302 ! heat flux associated with ice-ocean mass exchange 360 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_thd !: ice-ocean heat flux from thermo processes ( limthd_dh)[W.m-2]361 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_dyn !: ice-ocean heat flux from mecanical processes (limitd_me)[W.m-2]303 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_thd !: ice-ocean heat flux from thermo processes (icethd_dh) [W.m-2] 304 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_dyn !: ice-ocean heat flux from ridging [W.m-2] 362 305 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_res !: residual heat flux due to correction of ice thickness [W.m-2] 363 306 364 307 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rn_amax_2d !: maximum ice concentration 2d array 365 308 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ftr_ice !: transmitted solar radiation under ice 366 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: pahu3D, pahv3D !: ice hor. eddy diffusivity coef. at U- and V-points 367 368 !!-------------------------------------------------------------------------- 309 310 !!---------------------------------------------------------------------- 369 311 !! * Ice global state variables 370 !!---------------------------------------------------------------------- ----312 !!---------------------------------------------------------------------- 371 313 !! Variables defined for each ice category 372 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: h t_i!: Ice thickness (m)314 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: h_i !: Ice thickness (m) 373 315 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i !: Ice fractional areas (concentration) 374 316 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_i !: Ice volume per unit area (m) 375 317 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_s !: Snow volume per unit area(m) 376 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: h t_s!: Snow thickness (m)318 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: h_s !: Snow thickness (m) 377 319 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: t_su !: Sea-Ice Surface Temperature (K) 378 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sm_i !: Sea-Ice Bulk salinity (ppt) 379 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: smv_i !: Sea-Ice Bulk salinity times volume per area (ppt.m) 380 ! ! this is an extensive variable that has to be transported 381 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: o_i !: Sea-Ice Age (days) 382 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: oa_i !: Sea-Ice Age times ice area (days) 320 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: s_i !: Sea-Ice Bulk salinity (ppt) 321 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sv_i !: Sea-Ice Bulk salinity times volume per area (ppt.m) 322 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: o_i !: Sea-Ice Age (s) 323 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: oa_i !: Sea-Ice Age times ice area (s) 383 324 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: bv_i !: brine volume 384 325 … … 391 332 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tm_i !: mean ice temperature over all categories 392 333 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: bvm_i !: brine volume averaged over all categories 393 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sm t_i!: mean sea ice salinity averaged over all categories [PSU]334 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sm_i !: mean sea ice salinity averaged over all categories [PSU] 394 335 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tm_su !: mean surface temperature over all categories 395 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: h tm_i!: mean ice thickness over all categories396 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: h tm_s!: mean snow thickness over all categories336 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hm_i !: mean ice thickness over all categories 337 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hm_s !: mean snow thickness over all categories 397 338 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: om_i !: mean ice age over all categories 398 339 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tau_icebfr !: ice friction with bathy (landfast param activated) 399 340 400 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: t_s !: Snow temperatures [K] 401 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_s !: Snow ... 402 403 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: t_i !: ice temperatures [K] 404 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_i !: ice thermal contents [J/m2] 405 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: s_i !: ice salinities [PSU] 406 407 !!-------------------------------------------------------------------------- 408 !! * Moments for advection 409 !!-------------------------------------------------------------------------- 410 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sxopw, syopw, sxxopw, syyopw, sxyopw !: open water in sea ice 411 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxice, syice, sxxice, syyice, sxyice !: ice thickness 412 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxsn , sysn , sxxsn , syysn , sxysn !: snow thickness 413 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxa , sya , sxxa , syya , sxya !: lead fraction 414 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxc0 , syc0 , sxxc0 , syyc0 , sxyc0 !: snow thermal content 415 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxsal, sysal, sxxsal, syysal, sxysal !: ice salinity 416 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sxage, syage, sxxage, syyage, sxyage !: ice age 417 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: sxe , sye , sxxe , syye , sxye !: ice layers heat content 418 419 !!-------------------------------------------------------------------------- 341 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: t_s !: Snow temperatures [K] 342 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_s !: Snow enthalpy [J/m2] 343 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: t_i !: ice temperatures [K] 344 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_i !: ice enthalpy [J/m2] 345 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: sz_i !: ice salinity [PSU] 346 347 ! MV MP 2016 348 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_ip !: melt pond fraction per grid cell area 349 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_ip !: melt pond volume per grid cell area [m] 350 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_ip_frac !: melt pond volume per ice area 351 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: h_ip !: melt pond thickness [m] 352 353 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: at_ip !: total melt pond fraction 354 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vt_ip !: total melt pond volume per unit area [m] 355 ! END MV MP 2016 356 357 !!---------------------------------------------------------------------- 420 358 !! * Old values of global variables 421 !!---------------------------------------------------------------------- ----422 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_s_b, v_i_b !: snow and ice volumes423 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i_b, s mv_i_b, oa_i_b!:424 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_s_b !: snow heat content425 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_i_b !: ice temperatures426 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice_b, v_ice_b !: ice velocity427 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: at_i_b !: ice concentration (total)359 !!---------------------------------------------------------------------- 360 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_s_b, v_i_b, h_s_b, h_i_b !: snow and ice volumes/thickness 361 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i_b, sv_i_b, oa_i_b !: 362 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_s_b !: snow heat content 363 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e_i_b !: ice temperatures 364 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice_b, v_ice_b !: ice velocity 365 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: at_i_b !: ice concentration (total) 428 366 429 !!---------------------------------------------------------------------- ----367 !!---------------------------------------------------------------------- 430 368 !! * Ice thickness distribution variables 431 !!---------------------------------------------------------------------- ----369 !!---------------------------------------------------------------------- 432 370 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hi_max !: Boundary of ice thickness categories in thickness space 433 371 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hi_mean !: Mean ice thickness in catgories 434 372 ! 435 !!---------------------------------------------------------------------- ----373 !!---------------------------------------------------------------------- 436 374 !! * Ice diagnostics 437 !!---------------------------------------------------------------------- ----375 !!---------------------------------------------------------------------- 438 376 ! thd refers to changes induced by thermodynamics 439 377 ! trp '' '' '' advection (transport of ice) … … 443 381 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_ei !: transport of ice enthalpy (W/m2) 444 382 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_es !: transport of snw enthalpy (W/m2) 445 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_s mv!: transport of salt content383 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_sv !: transport of salt content 446 384 ! 447 385 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_heat !: snw/ice heat content variation [W/m2] 448 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_s mvi!: ice salt content variation []386 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_sice !: ice salt content variation [] 449 387 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_vice !: ice volume variation [m/s] 450 388 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_vsnw !: snw volume variation [m/s] 451 ! 452 !!---------------------------------------------------------------------- 453 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2010) 389 390 ! 391 !!---------------------------------------------------------------------- 392 !! * SIMIP extra diagnostics 393 !!---------------------------------------------------------------------- 394 ! Extra sea ice diagnostics to address the data request 395 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: t_si !: Temperature at Snow-ice interface (K) 396 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tm_si !: mean temperature at the snow-ice interface (K) 397 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_fc_bo !: Bottom conduction flux (W/m2) 398 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_fc_su !: Surface conduction flux (W/m2) 399 400 ! 401 !!---------------------------------------------------------------------- 402 !! NEMO/ICE 4.0 , NEMO Consortium (2017) 454 403 !! $Id$ 455 404 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 463 412 INTEGER :: ice_alloc 464 413 ! 465 INTEGER :: ierr(1 5), ii414 INTEGER :: ierr(18), ii 466 415 !!----------------------------------------------------------------- 467 416 … … 471 420 ! stay within Fortran's max-line length limit. 472 421 ii = 1 473 ALLOCATE( u_oce (jpi,jpj) , v_oce (jpi,jpj) , & 474 & ahiu (jpi,jpj) , ahiv (jpi,jpj) , hicol (jpi,jpj) , & 422 ALLOCATE( u_oce (jpi,jpj) , v_oce (jpi,jpj) , ht_i_new (jpi,jpj) , & 475 423 & strength(jpi,jpj) , stress1_i(jpi,jpj) , stress2_i(jpi,jpj) , stress12_i(jpi,jpj) , & 476 424 & delta_i (jpi,jpj) , divu_i (jpi,jpj) , shear_i (jpi,jpj) , STAT=ierr(ii) ) 477 425 478 426 ii = ii + 1 479 ALLOCATE( t_bo (jpi,jpj) , frld (jpi,jpj) , pfrld (jpi,jpj) , phicif (jpi,jpj) , & 480 & wfx_snw(jpi,jpj) , wfx_ice(jpi,jpj) , wfx_sub(jpi,jpj) , wfx_lam(jpi,jpj) , & 427 ALLOCATE( t_bo (jpi,jpj) , wfx_snw_sni(jpi,jpj) , & 428 & wfx_snw(jpi,jpj) , wfx_snw_dyn(jpi,jpj) , wfx_snw_sum(jpi,jpj) , wfx_snw_sub(jpi,jpj) , & 429 & wfx_ice(jpi,jpj) , wfx_sub (jpi,jpj) , wfx_ice_sub(jpi,jpj) , wfx_lam (jpi,jpj) , & 430 & wfx_pnd(jpi,jpj) , & 481 431 & wfx_bog(jpi,jpj) , wfx_dyn(jpi,jpj) , wfx_bom(jpi,jpj) , wfx_sum(jpi,jpj) , & 482 432 & wfx_res(jpi,jpj) , wfx_sni(jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) , & 483 & afx_tot(jpi,jpj) , afx_thd(jpi,jpj), afx_dyn(jpi,jpj) , rn_amax_2d(jpi,jpj),&433 & afx_tot(jpi,jpj) , rn_amax_2d(jpi,jpj), & 484 434 & fhtur (jpi,jpj) , qlead (jpi,jpj) , & 485 435 & sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) , sfx_sub(jpi,jpj) , sfx_lam(jpi,jpj) , & 486 436 & sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) , & 487 & hfx_res(jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) , hfx_err(jpi,jpj) ,&437 & hfx_res(jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) , & 488 438 & hfx_in (jpi,jpj) , hfx_out(jpi,jpj) , fhld (jpi,jpj) , & 489 439 & hfx_sum(jpi,jpj) , hfx_bom(jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) , & … … 493 443 ! * Ice global state variables 494 444 ii = ii + 1 495 ALLOCATE( ftr_ice(jpi,jpj,jpl) , pahu3D(jpi,jpj,jpl+1) , pahv3D(jpi,jpj,jpl+1) ,&496 & h t_i (jpi,jpj,jpl) , a_i (jpi,jpj,jpl) , v_i (jpi,jpj,jpl) , &497 & v_s (jpi,jpj,jpl) , h t_s (jpi,jpj,jpl) , t_su (jpi,jpj,jpl) , &498 & s m_i (jpi,jpj,jpl) , smv_i (jpi,jpj,jpl) , o_i (jpi,jpj,jpl) , &445 ALLOCATE( ftr_ice(jpi,jpj,jpl) , & 446 & h_i (jpi,jpj,jpl) , a_i (jpi,jpj,jpl) , v_i (jpi,jpj,jpl) , & 447 & v_s (jpi,jpj,jpl) , h_s (jpi,jpj,jpl) , t_su (jpi,jpj,jpl) , & 448 & s_i (jpi,jpj,jpl) , sv_i (jpi,jpj,jpl) , o_i (jpi,jpj,jpl) , & 499 449 & oa_i (jpi,jpj,jpl) , bv_i (jpi,jpj,jpl) , STAT=ierr(ii) ) 500 450 ii = ii + 1 … … 502 452 & vt_i (jpi,jpj) , vt_s (jpi,jpj) , at_i (jpi,jpj) , ato_i(jpi,jpj) , & 503 453 & et_i (jpi,jpj) , et_s (jpi,jpj) , tm_i (jpi,jpj) , bvm_i(jpi,jpj) , & 504 & sm t_i(jpi,jpj) , tm_su(jpi,jpj) , htm_i(jpi,jpj) , htm_s(jpi,jpj) , &454 & sm_i (jpi,jpj) , tm_su(jpi,jpj) , hm_i(jpi,jpj) , hm_s(jpi,jpj) , & 505 455 & om_i (jpi,jpj) , tau_icebfr(jpi,jpj) , STAT=ierr(ii) ) 506 456 ii = ii + 1 507 457 ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) , e_s(jpi,jpj,nlay_s,jpl) , STAT=ierr(ii) ) 508 458 ii = ii + 1 509 ALLOCATE( t_i(jpi,jpj,nlay_i,jpl) , e_i(jpi,jpj,nlay_i,jpl) , s_i(jpi,jpj,nlay_i,jpl) , STAT=ierr(ii) ) 510 511 ! * Moments for advection 512 ii = ii + 1 513 ALLOCATE( sxopw(jpi,jpj) , syopw(jpi,jpj) , sxxopw(jpi,jpj) , syyopw(jpi,jpj) , sxyopw(jpi,jpj) , STAT=ierr(ii) ) 514 ii = ii + 1 515 ALLOCATE( sxice(jpi,jpj,jpl) , syice(jpi,jpj,jpl) , sxxice(jpi,jpj,jpl) , syyice(jpi,jpj,jpl) , sxyice(jpi,jpj,jpl) , & 516 & sxsn (jpi,jpj,jpl) , sysn (jpi,jpj,jpl) , sxxsn (jpi,jpj,jpl) , syysn (jpi,jpj,jpl) , sxysn (jpi,jpj,jpl) , & 517 & STAT=ierr(ii) ) 518 ii = ii + 1 519 ALLOCATE( sxa (jpi,jpj,jpl) , sya (jpi,jpj,jpl) , sxxa (jpi,jpj,jpl) , syya (jpi,jpj,jpl) , sxya (jpi,jpj,jpl) , & 520 & sxc0 (jpi,jpj,jpl) , syc0 (jpi,jpj,jpl) , sxxc0 (jpi,jpj,jpl) , syyc0 (jpi,jpj,jpl) , sxyc0 (jpi,jpj,jpl) , & 521 & sxsal(jpi,jpj,jpl) , sysal(jpi,jpj,jpl) , sxxsal(jpi,jpj,jpl) , syysal(jpi,jpj,jpl) , sxysal(jpi,jpj,jpl) , & 522 & sxage(jpi,jpj,jpl) , syage(jpi,jpj,jpl) , sxxage(jpi,jpj,jpl) , syyage(jpi,jpj,jpl) , sxyage(jpi,jpj,jpl) , & 523 & STAT=ierr(ii) ) 524 ii = ii + 1 525 ALLOCATE( sxe (jpi,jpj,nlay_i,jpl) , sye (jpi,jpj,nlay_i,jpl) , sxxe(jpi,jpj,nlay_i,jpl) , & 526 & syye(jpi,jpj,nlay_i,jpl) , sxye(jpi,jpj,nlay_i,jpl) , STAT=ierr(ii) ) 459 ALLOCATE( t_i(jpi,jpj,nlay_i,jpl) , e_i(jpi,jpj,nlay_i,jpl) , sz_i(jpi,jpj,nlay_i,jpl) , STAT=ierr(ii) ) 460 461 ii = ii + 1 462 ALLOCATE( a_ip(jpi,jpj,jpl) , v_ip(jpi,jpj,jpl) , a_ip_frac(jpi,jpj,jpl) , & 463 & h_ip(jpi,jpj,jpl) , STAT = ierr(ii) ) 464 ii = ii + 1 465 ALLOCATE( at_ip(jpi,jpj) , vt_ip(jpi,jpj) , STAT = ierr(ii) ) 527 466 528 467 ! * Old values of global variables 529 468 ii = ii + 1 530 ALLOCATE( v_s_b (jpi,jpj,jpl) , v_i_b (jpi,jpj,jpl) , e_s_b(jpi,jpj,nlay_s,jpl) ,&531 & a_i_b (jpi,jpj,jpl) , s mv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i,jpl) ,&532 & oa_i_b (jpi,jpj,jpl) , STAT=ierr(ii) )469 ALLOCATE( v_s_b (jpi,jpj,jpl) , v_i_b (jpi,jpj,jpl) , h_s_b(jpi,jpj,jpl) , h_i_b(jpi,jpj,jpl) , & 470 & a_i_b (jpi,jpj,jpl) , sv_i_b(jpi,jpj,jpl) , e_i_b (jpi,jpj,nlay_i,jpl) , e_s_b (jpi,jpj,nlay_s,jpl) , & 471 & oa_i_b (jpi,jpj,jpl) , STAT=ierr(ii) ) 533 472 ii = ii + 1 534 473 ALLOCATE( u_ice_b(jpi,jpj) , v_ice_b(jpi,jpj) , at_i_b(jpi,jpj) , STAT=ierr(ii) ) … … 541 480 ii = ii + 1 542 481 ALLOCATE( diag_trp_vi(jpi,jpj) , diag_trp_vs (jpi,jpj) , diag_trp_ei(jpi,jpj), & 543 & diag_trp_es(jpi,jpj) , diag_trp_smv(jpi,jpj) , diag_heat (jpi,jpj), & 544 & diag_smvi (jpi,jpj) , diag_vice (jpi,jpj) , diag_vsnw (jpi,jpj), STAT=ierr(ii) ) 482 & diag_trp_es(jpi,jpj) , diag_trp_sv (jpi,jpj) , diag_heat (jpi,jpj), & 483 & diag_sice (jpi,jpj) , diag_vice (jpi,jpj) , diag_vsnw (jpi,jpj), STAT=ierr(ii) ) 484 485 ! * SIMIP diagnostics 486 ii = ii + 1 487 ALLOCATE( t_si (jpi,jpj,jpl) , tm_si(jpi,jpj) , & 488 diag_fc_bo(jpi,jpj) , diag_fc_su(jpi,jpj) , & 489 STAT = ierr(ii) ) 545 490 546 491 ice_alloc = MAXVAL( ierr(:) ) … … 551 496 #else 552 497 !!---------------------------------------------------------------------- 553 !! Default option Empty module NO LIM sea-ice model498 !! Default option Empty module NO ESIM sea-ice model 554 499 !!---------------------------------------------------------------------- 555 500 #endif -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_ice.F90
r8733 r8738 7 7 !! 3.6 ! 2016-05 (C. Rousset) Add LIM3 compatibility 8 8 !!---------------------------------------------------------------------- 9 #if defined key_agrif && defined key_lim2 10 !!---------------------------------------------------------------------- 11 !! 'key_agrif' AGRIF zoom 12 !!---------------------------------------------------------------------- 13 USE par_oce ! ocean parameters 14 15 IMPLICIT NONE 16 PRIVATE 17 18 PUBLIC agrif_ice_alloc ! routine called by nemo_init in nemogcm.F90 19 20 INTEGER, PUBLIC :: u_ice_id, v_ice_id, adv_ice_id 21 REAL(wp), PUBLIC :: lim_nbstep = 0. ! child time position in sea-ice model 22 #if defined key_lim2_vp 23 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: u_ice_nst, v_ice_nst 24 #else 25 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: u_ice_oe, u_ice_sn !: boundaries arrays 26 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: v_ice_oe, v_ice_sn !: " " 27 #endif 28 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:,:) :: adv_ice_oe, adv_ice_sn !: " " 29 30 !!---------------------------------------------------------------------- 31 !! NEMO/NST 3.3.4 , NEMO Consortium (2012) 32 !! $Id$ 33 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 34 !!---------------------------------------------------------------------- 35 36 CONTAINS 37 38 INTEGER FUNCTION agrif_ice_alloc() 39 !!---------------------------------------------------------------------- 40 !! *** FUNCTION agrif_ice_alloc *** 41 !!---------------------------------------------------------------------- 42 #if defined key_lim2_vp 43 ALLOCATE( u_ice_nst(jpi,jpj), v_ice_nst(jpi,jpj) , & 44 #else 45 ALLOCATE( u_ice_oe(4,jpj,2) , v_ice_oe(4,jpj,2) , & 46 & u_ice_sn(jpi,4,2) , v_ice_sn(jpi,4,2) , & 47 #endif 48 & adv_ice_oe (4,jpj,7,2) , adv_ice_sn (jpi,4,7,2) , & 49 & STAT = agrif_ice_alloc) 50 51 #if ! defined key_lim2_vp 52 u_ice_oe(:,:,:) = 0.e0 53 v_ice_oe(:,:,:) = 0.e0 54 u_ice_sn(:,:,:) = 0.e0 55 v_ice_sn(:,:,:) = 0.e0 56 #endif 57 adv_ice_oe (:,:,:,:) = 0.e0 58 adv_ice_sn (:,:,:,:) = 0.e0 59 ! 60 END FUNCTION agrif_ice_alloc 61 62 #elif defined key_agrif && defined key_lim3 9 #if defined key_agrif && defined key_lim3 63 10 !!---------------------------------------------------------------------- 64 11 !! 'key_agrif' AGRIF zoom -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_lim3_interp.F90
r8733 r8738 52 52 !!----------------------------------------------------------------------- 53 53 ! 54 IF( Agrif_Root() ) RETURN54 IF( Agrif_Root() .OR. nn_ice==0 ) RETURN ! clem2017: do not interpolate if inside Parent domain or if child domain does not have ice 55 55 ! 56 56 SELECT CASE(cd_type) … … 90 90 !! i1 i2 j1 j2 are the index of the boundaries parent(when before) and child (when after) 91 91 !! To solve issues when parent grid is "land" masked but not all the corresponding child grid points, 92 !! put -999 9WHERE the parent grid is masked. The child solution will be found in the 9(?) points around92 !! put -999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around 93 93 !!----------------------------------------------------------------------- 94 94 INTEGER , INTENT(in) :: i1, i2, j1, j2 … … 101 101 IF( before ) THEN ! parent grid 102 102 ptab(:,:) = e2u(i1:i2,j1:j2) * u_ice_b(i1:i2,j1:j2) 103 WHERE( umask(i1:i2,j1:j2,1) == 0. ) ptab(:,:) = -9999.103 WHERE( umask(i1:i2,j1:j2,1) == 0. ) ptab(i1:i2,j1:j2) = Agrif_SpecialValue 104 104 ELSE ! child grid 105 105 zrhoy = Agrif_Rhoy() 106 u_ice(i1:i2,j1:j2) = ptab( :,:) / ( e2u(i1:i2,j1:j2) * zrhoy ) * umask(i1:i2,j1:j2,1)106 u_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / ( e2u(i1:i2,j1:j2) * zrhoy ) * umask(i1:i2,j1:j2,1) 107 107 ENDIF 108 108 ! … … 116 116 !! i1 i2 j1 j2 are the index of the boundaries parent(when before) and child (when after) 117 117 !! To solve issues when parent grid is "land" masked but not all the corresponding child grid points, 118 !! put -999 9WHERE the parent grid is masked. The child solution will be found in the 9(?) points around118 !! put -999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around 119 119 !!----------------------------------------------------------------------- 120 120 INTEGER , INTENT(in) :: i1, i2, j1, j2 … … 127 127 IF( before ) THEN ! parent grid 128 128 ptab(:,:) = e1v(i1:i2,j1:j2) * v_ice_b(i1:i2,j1:j2) 129 WHERE( vmask(i1:i2,j1:j2,1) == 0. ) ptab( :,:) = -9999.129 WHERE( vmask(i1:i2,j1:j2,1) == 0. ) ptab(i1:i2,j1:j2) = Agrif_SpecialValue 130 130 ELSE ! child grid 131 131 zrhox = Agrif_Rhox() 132 v_ice(i1:i2,j1:j2) = ptab( :,:) / ( e1v(i1:i2,j1:j2) * zrhox ) * vmask(i1:i2,j1:j2,1)132 v_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / ( e1v(i1:i2,j1:j2) * zrhox ) * vmask(i1:i2,j1:j2,1) 133 133 ENDIF 134 134 ! … … 142 142 !! i1 i2 j1 j2 are the index of the boundaries parent(when before) and child (when after) 143 143 !! To solve issues when parent grid is "land" masked but not all the corresponding child grid points, 144 !! put -999 9WHERE the parent grid is masked. The child solution will be found in the 9(?) points around144 !! put -999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around 145 145 !!----------------------------------------------------------------------- 146 146 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab … … 158 158 ! tracers are not multiplied by grid cell here => before: * e12t ; after: * r1_e12t / rhox / rhoy 159 159 ! and it is ok since we conserve tracers (same as in the ocean). 160 ALLOCATE( ztab(SIZE(a_i _b,1),SIZE(a_i_b,2),SIZE(ptab,3)) )160 ALLOCATE( ztab(SIZE(a_i,1),SIZE(a_i,2),SIZE(ptab,3)) ) 161 161 162 162 IF( before ) THEN ! parent grid 163 163 jm = 1 164 164 DO jl = 1, jpl 165 ptab(i1:i2,j1:j2,jm) = a_i_b (i1:i2,j1:j2,jl) ; jm = jm + 1 166 ptab(i1:i2,j1:j2,jm) = v_i_b (i1:i2,j1:j2,jl) ; jm = jm + 1 167 ptab(i1:i2,j1:j2,jm) = v_s_b (i1:i2,j1:j2,jl) ; jm = jm + 1 168 ptab(i1:i2,j1:j2,jm) = smv_i_b(i1:i2,j1:j2,jl) ; jm = jm + 1 169 ptab(i1:i2,j1:j2,jm) = oa_i_b (i1:i2,j1:j2,jl) ; jm = jm + 1 165 ptab(i1:i2,j1:j2,jm ) = a_i_b (i1:i2,j1:j2,jl) 166 ptab(i1:i2,j1:j2,jm+1) = v_i_b (i1:i2,j1:j2,jl) 167 ptab(i1:i2,j1:j2,jm+2) = v_s_b (i1:i2,j1:j2,jl) 168 ptab(i1:i2,j1:j2,jm+3) = sv_i_b(i1:i2,j1:j2,jl) 169 ptab(i1:i2,j1:j2,jm+4) = oa_i_b(i1:i2,j1:j2,jl) 170 jm = jm + 5 170 171 DO jk = 1, nlay_s 171 172 ptab(i1:i2,j1:j2,jm) = e_s_b(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 … … 177 178 178 179 DO jk = k1, k2 179 WHERE( tmask(i1:i2,j1:j2,1) == 0. ) ptab(i1:i2,j1:j2,jk) = -9999.180 WHERE( tmask(i1:i2,j1:j2,1) == 0. ) ptab(i1:i2,j1:j2,jk) = Agrif_SpecialValue 180 181 ENDDO 181 182 182 183 ELSE ! child grid 183 !! ==> The easiest interpolation is the following commented lines 184 jm = 1 185 DO jl = 1, jpl 186 a_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 187 v_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 188 v_s (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 189 smv_i(i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 190 oa_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 191 DO jk = 1, nlay_s 192 e_s(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 193 ENDDO 194 DO jk = 1, nlay_i 195 e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 196 ENDDO 197 ENDDO 198 199 !! ==> this is a more complex interpolation since we mix solutions over a couple of grid points 200 !! it is advised to use it for fields modified by high order schemes (e.g. advection UM5...) 201 !! clem: for some reason (I don't know why), the following lines do not work 202 !! with mpp (or in realistic configurations?). It makes the model crash 203 ! ! record ztab 204 ! jm = 1 205 ! DO jl = 1, jpl 206 ! ztab(:,:,jm) = a_i (:,:,jl) ; jm = jm + 1 207 ! ztab(:,:,jm) = v_i (:,:,jl) ; jm = jm + 1 208 ! ztab(:,:,jm) = v_s (:,:,jl) ; jm = jm + 1 209 ! ztab(:,:,jm) = smv_i(:,:,jl) ; jm = jm + 1 210 ! ztab(:,:,jm) = oa_i (:,:,jl) ; jm = jm + 1 211 ! DO jk = 1, nlay_s 212 ! ztab(:,:,jm) = e_s(:,:,jk,jl) ; jm = jm + 1 213 ! ENDDO 214 ! DO jk = 1, nlay_i 215 ! ztab(:,:,jm) = e_i(:,:,jk,jl) ; jm = jm + 1 216 ! ENDDO 217 ! ENDDO 218 ! ! 219 ! ! borders of the domain 220 ! western_side = (nb == 1).AND.(ndir == 1) ; eastern_side = (nb == 1).AND.(ndir == 2) 221 ! southern_side = (nb == 2).AND.(ndir == 1) ; northern_side = (nb == 2).AND.(ndir == 2) 222 ! ! 223 ! ! spatial smoothing 224 ! zrhox = Agrif_Rhox() 225 ! z1 = ( zrhox - 1. ) * 0.5 226 ! z3 = ( zrhox - 1. ) / ( zrhox + 1. ) 227 ! z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 228 ! z7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 229 ! z2 = 1. - z1 230 ! z4 = 1. - z3 231 ! z5 = 1. - z6 - z7 232 ! ! 233 ! ! Remove corners 234 ! imin = i1 ; imax = i2 ; jmin = j1 ; jmax = j2 235 ! IF( (nbondj == -1) .OR. (nbondj == 2) ) jmin = 3 236 ! IF( (nbondj == +1) .OR. (nbondj == 2) ) jmax = nlcj-2 237 ! IF( (nbondi == -1) .OR. (nbondi == 2) ) imin = 3 238 ! IF( (nbondi == +1) .OR. (nbondi == 2) ) imax = nlci-2 239 ! 240 ! ! smoothed fields 241 ! IF( eastern_side ) THEN 242 ! ztab(nlci,j1:j2,:) = z1 * ptab(nlci,j1:j2,:) + z2 * ptab(nlci-1,j1:j2,:) 243 ! DO jj = jmin, jmax 244 ! rswitch = 0. 245 ! IF( u_ice(nlci-2,jj) > 0._wp ) rswitch = 1. 246 ! ztab(nlci-1,jj,:) = ( 1. - umask(nlci-2,jj,1) ) * ztab(nlci,jj,:) & 247 ! & + umask(nlci-2,jj,1) * & 248 ! & ( ( 1. - rswitch ) * ( z4 * ztab(nlci,jj,:) + z3 * ztab(nlci-2,jj,:) ) & 249 ! & + rswitch * ( z6 * ztab(nlci-2,jj,:) + z5 * ztab(nlci,jj,:) + z7 * ztab(nlci-3,jj,:) ) ) 250 ! ztab(nlci-1,jj,:) = ztab(nlci-1,jj,:) * tmask(nlci-1,jj,1) 251 ! END DO 252 ! ENDIF 253 ! ! 254 ! IF( northern_side ) THEN 255 ! ztab(i1:i2,nlcj,:) = z1 * ptab(i1:i2,nlcj,:) + z2 * ptab(i1:i2,nlcj-1,:) 256 ! DO ji = imin, imax 257 ! rswitch = 0. 258 ! IF( v_ice(ji,nlcj-2) > 0._wp ) rswitch = 1. 259 ! ztab(ji,nlcj-1,:) = ( 1. - vmask(ji,nlcj-2,1) ) * ztab(ji,nlcj,:) & 260 ! & + vmask(ji,nlcj-2,1) * & 261 ! & ( ( 1. - rswitch ) * ( z4 * ztab(ji,nlcj,:) + z3 * ztab(ji,nlcj-2,:) ) & 262 ! & + rswitch * ( z6 * ztab(ji,nlcj-2,:) + z5 * ztab(ji,nlcj,:) + z7 * ztab(ji,nlcj-3,:) ) ) 263 ! ztab(ji,nlcj-1,:) = ztab(ji,nlcj-1,:) * tmask(ji,nlcj-1,1) 264 ! END DO 265 ! END IF 266 ! ! 267 ! IF( western_side) THEN 268 ! ztab(1,j1:j2,:) = z1 * ptab(1,j1:j2,:) + z2 * ptab(2,j1:j2,:) 269 ! DO jj = jmin, jmax 270 ! rswitch = 0. 271 ! IF( u_ice(2,jj) < 0._wp ) rswitch = 1. 272 ! ztab(2,jj,:) = ( 1. - umask(2,jj,1) ) * ztab(1,jj,:) & 273 ! & + umask(2,jj,1) * & 274 ! & ( ( 1. - rswitch ) * ( z4 * ztab(1,jj,:) + z3 * ztab(3,jj,:) ) & 275 ! & + rswitch * ( z6 * ztab(3,jj,:) + z5 * ztab(1,jj,:) + z7 * ztab(4,jj,:) ) ) 276 ! ztab(2,jj,:) = ztab(2,jj,:) * tmask(2,jj,1) 277 ! END DO 278 ! ENDIF 279 ! ! 280 ! IF( southern_side ) THEN 281 ! ztab(i1:i2,1,:) = z1 * ptab(i1:i2,1,:) + z2 * ptab(i1:i2,2,:) 282 ! DO ji = imin, imax 283 ! rswitch = 0. 284 ! IF( v_ice(ji,2) < 0._wp ) rswitch = 1. 285 ! ztab(ji,2,:) = ( 1. - vmask(ji,2,1) ) * ztab(ji,1,:) & 286 ! & + vmask(ji,2,1) * & 287 ! & ( ( 1. - rswitch ) * ( z4 * ztab(ji,1,:) + z3 * ztab(ji,3,:) ) & 288 ! & + rswitch * ( z6 * ztab(ji,3,:) + z5 * ztab(ji,1,:) + z7 * ztab(ji,4,:) ) ) 289 ! ztab(ji,2,:) = ztab(ji,2,:) * tmask(ji,2,1) 290 ! END DO 291 ! END IF 292 ! ! 293 ! ! Treatment of corners 294 ! IF( (eastern_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) ) ztab(nlci-1,2,:) = ptab(nlci-1,2,:) ! East south 295 ! IF( (eastern_side) .AND. ((nbondj == 1).OR.(nbondj == 2)) ) ztab(nlci-1,nlcj-1,:) = ptab(nlci-1,nlcj-1,:) ! East north 296 ! IF( (western_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) ) ztab(2,2,:) = ptab(2,2,:) ! West south 297 ! IF( (western_side) .AND. ((nbondj == 1).OR.(nbondj == 2)) ) ztab(2,nlcj-1,:) = ptab(2,nlcj-1,:) ! West north 298 ! 299 ! ! retrieve ice tracers 300 ! jm = 1 301 ! DO jl = 1, jpl 302 ! a_i (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 303 ! v_i (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 304 ! v_s (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 305 ! smv_i(i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 306 ! oa_i (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 307 ! DO jk = 1, nlay_s 308 ! e_s(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 309 ! ENDDO 310 ! DO jk = 1, nlay_i 311 ! e_i(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 312 ! ENDDO 313 ! ENDDO 314 184 185 IF( nbghostcells > 1 ) THEN 186 !! ==> The easiest interpolation is the following lines 187 188 jm = 1 189 DO jl = 1, jpl 190 ! 191 DO jj = j1, j2 192 DO ji = i1, i2 193 a_i (ji,jj,jl) = ptab(ji,jj,jm ) * tmask(ji,jj,1) 194 v_i (ji,jj,jl) = ptab(ji,jj,jm+1) * tmask(ji,jj,1) 195 v_s (ji,jj,jl) = ptab(ji,jj,jm+2) * tmask(ji,jj,1) 196 sv_i(ji,jj,jl) = ptab(ji,jj,jm+3) * tmask(ji,jj,1) 197 oa_i(ji,jj,jl) = ptab(ji,jj,jm+4) * tmask(ji,jj,1) 198 ENDDO 199 ENDDO 200 jm = jm + 5 201 ! 202 DO jk = 1, nlay_s 203 e_s(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) 204 jm = jm + 1 205 ENDDO 206 ! 207 DO jk = 1, nlay_i 208 e_i(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) 209 jm = jm + 1 210 ENDDO 211 ! 212 ENDDO 213 214 ELSE 215 !! ==> this is a more complex interpolation since we mix solutions over a couple of grid points 216 !! it is advised to use it for fields modified by high order schemes (e.g. advection UM5...) 217 !! clem: for some reason (I don't know why), the following lines do not work 218 !! with mpp (or in realistic configurations?). It makes the model crash 219 ! I think there is an issue with Agrif_SpecialValue here (not taken into account properly) 220 ! record ztab 221 jm = 1 222 DO jl = 1, jpl 223 ztab(:,:,jm ) = a_i (:,:,jl) 224 ztab(:,:,jm+1) = v_i (:,:,jl) 225 ztab(:,:,jm+2) = v_s (:,:,jl) 226 ztab(:,:,jm+3) = sv_i(:,:,jl) 227 ztab(:,:,jm+4) = oa_i(:,:,jl) 228 jm = jm + 5 229 DO jk = 1, nlay_s 230 ztab(:,:,jm) = e_s(:,:,jk,jl) 231 jm = jm + 1 232 ENDDO 233 DO jk = 1, nlay_i 234 ztab(:,:,jm) = e_i(:,:,jk,jl) 235 jm = jm + 1 236 ENDDO 237 ! 238 ENDDO 239 ! 240 ! borders of the domain 241 western_side = (nb == 1).AND.(ndir == 1) ; eastern_side = (nb == 1).AND.(ndir == 2) 242 southern_side = (nb == 2).AND.(ndir == 1) ; northern_side = (nb == 2).AND.(ndir == 2) 243 ! 244 ! spatial smoothing 245 zrhox = Agrif_Rhox() 246 z1 = ( zrhox - 1. ) * 0.5 247 z3 = ( zrhox - 1. ) / ( zrhox + 1. ) 248 z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 249 z7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 250 z2 = 1. - z1 251 z4 = 1. - z3 252 z5 = 1. - z6 - z7 253 ! 254 ! Remove corners 255 imin = i1 ; imax = i2 ; jmin = j1 ; jmax = j2 256 IF( (nbondj == -1) .OR. (nbondj == 2) ) jmin = 3 257 IF( (nbondj == +1) .OR. (nbondj == 2) ) jmax = nlcj-2 258 IF( (nbondi == -1) .OR. (nbondi == 2) ) imin = 3 259 IF( (nbondi == +1) .OR. (nbondi == 2) ) imax = nlci-2 260 261 ! smoothed fields 262 IF( eastern_side ) THEN 263 ztab(nlci,j1:j2,:) = z1 * ptab(nlci,j1:j2,:) + z2 * ptab(nlci-1,j1:j2,:) 264 DO jj = jmin, jmax 265 rswitch = 0. 266 IF( u_ice(nlci-2,jj) > 0._wp ) rswitch = 1. 267 ztab(nlci-1,jj,:) = ( 1. - umask(nlci-2,jj,1) ) * ztab(nlci,jj,:) & 268 & + umask(nlci-2,jj,1) * & 269 & ( ( 1. - rswitch ) * ( z4 * ztab(nlci,jj,:) + z3 * ztab(nlci-2,jj,:) ) & 270 & + rswitch * ( z6 * ztab(nlci-2,jj,:) + z5 * ztab(nlci,jj,:) + z7 * ztab(nlci-3,jj,:) ) ) 271 ztab(nlci-1,jj,:) = ztab(nlci-1,jj,:) * tmask(nlci-1,jj,1) 272 END DO 273 ENDIF 274 ! 275 IF( northern_side ) THEN 276 ztab(i1:i2,nlcj,:) = z1 * ptab(i1:i2,nlcj,:) + z2 * ptab(i1:i2,nlcj-1,:) 277 DO ji = imin, imax 278 rswitch = 0. 279 IF( v_ice(ji,nlcj-2) > 0._wp ) rswitch = 1. 280 ztab(ji,nlcj-1,:) = ( 1. - vmask(ji,nlcj-2,1) ) * ztab(ji,nlcj,:) & 281 & + vmask(ji,nlcj-2,1) * & 282 & ( ( 1. - rswitch ) * ( z4 * ztab(ji,nlcj,:) + z3 * ztab(ji,nlcj-2,:) ) & 283 & + rswitch * ( z6 * ztab(ji,nlcj-2,:) + z5 * ztab(ji,nlcj,:) + z7 * ztab(ji,nlcj-3,:) ) ) 284 ztab(ji,nlcj-1,:) = ztab(ji,nlcj-1,:) * tmask(ji,nlcj-1,1) 285 END DO 286 END IF 287 ! 288 IF( western_side) THEN 289 ztab(1,j1:j2,:) = z1 * ptab(1,j1:j2,:) + z2 * ptab(2,j1:j2,:) 290 DO jj = jmin, jmax 291 rswitch = 0. 292 IF( u_ice(2,jj) < 0._wp ) rswitch = 1. 293 ztab(2,jj,:) = ( 1. - umask(2,jj,1) ) * ztab(1,jj,:) & 294 & + umask(2,jj,1) * & 295 & ( ( 1. - rswitch ) * ( z4 * ztab(1,jj,:) + z3 * ztab(3,jj,:) ) & 296 & + rswitch * ( z6 * ztab(3,jj,:) + z5 * ztab(1,jj,:) + z7 * ztab(4,jj,:) ) ) 297 ztab(2,jj,:) = ztab(2,jj,:) * tmask(2,jj,1) 298 END DO 299 ENDIF 300 ! 301 IF( southern_side ) THEN 302 ztab(i1:i2,1,:) = z1 * ptab(i1:i2,1,:) + z2 * ptab(i1:i2,2,:) 303 DO ji = imin, imax 304 rswitch = 0. 305 IF( v_ice(ji,2) < 0._wp ) rswitch = 1. 306 ztab(ji,2,:) = ( 1. - vmask(ji,2,1) ) * ztab(ji,1,:) & 307 & + vmask(ji,2,1) * & 308 & ( ( 1. - rswitch ) * ( z4 * ztab(ji,1,:) + z3 * ztab(ji,3,:) ) & 309 & + rswitch * ( z6 * ztab(ji,3,:) + z5 * ztab(ji,1,:) + z7 * ztab(ji,4,:) ) ) 310 ztab(ji,2,:) = ztab(ji,2,:) * tmask(ji,2,1) 311 END DO 312 END IF 313 ! 314 ! Treatment of corners 315 IF( (eastern_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) ) ztab(nlci-1,2,:) = ptab(nlci-1,2,:) ! East south 316 IF( (eastern_side) .AND. ((nbondj == 1).OR.(nbondj == 2)) ) ztab(nlci-1,nlcj-1,:) = ptab(nlci-1,nlcj-1,:) ! East north 317 IF( (western_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) ) ztab(2,2,:) = ptab(2,2,:) ! West south 318 IF( (western_side) .AND. ((nbondj == 1).OR.(nbondj == 2)) ) ztab(2,nlcj-1,:) = ptab(2,nlcj-1,:) ! West north 319 320 ! retrieve ice tracers 321 jm = 1 322 DO jl = 1, jpl 323 ! 324 DO jj = j1, j2 325 DO ji = i1, i2 326 a_i (ji,jj,jl) = ztab(ji,jj,jm ) * tmask(ji,jj,1) 327 v_i (ji,jj,jl) = ztab(ji,jj,jm+1) * tmask(ji,jj,1) 328 v_s (ji,jj,jl) = ztab(ji,jj,jm+2) * tmask(ji,jj,1) 329 sv_i(ji,jj,jl) = ztab(ji,jj,jm+3) * tmask(ji,jj,1) 330 oa_i (ji,jj,jl) = ztab(ji,jj,jm+4) * tmask(ji,jj,1) 331 ENDDO 332 ENDDO 333 jm = jm + 5 334 ! 335 DO jk = 1, nlay_s 336 e_s(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) 337 jm = jm + 1 338 ENDDO 339 ! 340 DO jk = 1, nlay_i 341 e_i(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) 342 jm = jm + 1 343 ENDDO 344 ! 345 ENDDO 346 347 ENDIF ! nbghostcells=1 348 315 349 ! integrated values 316 350 vt_i (i1:i2,j1:j2) = SUM( v_i(i1:i2,j1:j2,:), dim=3 ) … … 319 353 et_s(i1:i2,j1:j2) = SUM( SUM( e_s(i1:i2,j1:j2,:,:), dim=4 ), dim=3 ) 320 354 et_i(i1:i2,j1:j2) = SUM( SUM( e_i(i1:i2,j1:j2,:,:), dim=4 ), dim=3 ) 321 355 322 356 ENDIF 357 358 DEALLOCATE( ztab ) 323 359 324 DEALLOCATE( ztab )325 360 ! 326 361 END SUBROUTINE interp_tra_ice -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_lim3_update.F90
r8733 r8738 56 56 IF( ( MOD( (kt-nit000)/nn_fsbc + 1, Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) /=0 ) .AND. (kt /= 0) ) RETURN ! do not update if nb of child time steps differ from time refinement 57 57 ! i.e. update only at the parent time step 58 IF( nn_ice == 0 ) RETURN ! clem2017: do not update if child domain does not have ice 59 ! 60 Agrif_SpecialValueFineGrid = -9999. 58 61 Agrif_UseSpecialValueInUpdate = .TRUE. 59 Agrif_SpecialValueFineGrid = -9999.60 62 # if defined TWO_WAY 61 63 IF( MOD(nbcline,nbclineupdate) == 0) THEN ! update the whole basin at each nbclineupdate (=nn_cln_update) baroclinic parent time steps … … 70 72 ENDIF 71 73 # endif 74 Agrif_SpecialValueFineGrid = 0. 72 75 Agrif_UseSpecialValueInUpdate = .FALSE. 73 76 ! … … 88 91 LOGICAL , INTENT(in) :: before 89 92 !! 90 INTEGER :: j k, jl, jm93 INTEGER :: ji, jj, jk, jl, jm 91 94 !!----------------------------------------------------------------------- 92 95 ! it is ok not to multiply by e1*e2 since we conserve tracers here (same as in the ocean). … … 94 97 jm = 1 95 98 DO jl = 1, jpl 96 ptab(:,:,jm) = a_i (i1:i2,j1:j2,jl) ; jm = jm + 1 97 ptab(:,:,jm) = v_i (i1:i2,j1:j2,jl) ; jm = jm + 1 98 ptab(:,:,jm) = v_s (i1:i2,j1:j2,jl) ; jm = jm + 1 99 ptab(:,:,jm) = smv_i(i1:i2,j1:j2,jl) ; jm = jm + 1 100 ptab(:,:,jm) = oa_i (i1:i2,j1:j2,jl) ; jm = jm + 1 99 ptab(i1:i2,j1:j2,jm ) = a_i (i1:i2,j1:j2,jl) 100 ptab(i1:i2,j1:j2,jm+1) = v_i (i1:i2,j1:j2,jl) 101 ptab(i1:i2,j1:j2,jm+2) = v_s (i1:i2,j1:j2,jl) 102 ptab(i1:i2,j1:j2,jm+3) = sv_i(i1:i2,j1:j2,jl) 103 ptab(i1:i2,j1:j2,jm+4) = oa_i (i1:i2,j1:j2,jl) 104 jm = jm + 5 101 105 DO jk = 1, nlay_s 102 ptab( :,:,jm) = e_s(i1:i2,j1:j2,jk,jl) ; jm = jm + 1106 ptab(i1:i2,j1:j2,jm) = e_s(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 103 107 ENDDO 104 108 DO jk = 1, nlay_i 105 ptab( :,:,jm) = e_i(i1:i2,j1:j2,jk,jl) ; jm = jm + 1109 ptab(i1:i2,j1:j2,jm) = e_i(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 106 110 ENDDO 107 111 ENDDO 108 112 ! 109 113 DO jk = k1, k2 110 WHERE( tmask(i1:i2,j1:j2,1) == 0. ) ptab( :,:,jk) = -9999.114 WHERE( tmask(i1:i2,j1:j2,1) == 0. ) ptab(i1:i2,j1:j2,jk) = Agrif_SpecialValueFineGrid 111 115 ENDDO 112 116 ! 113 117 ELSE 118 ! 114 119 jm = 1 115 120 DO jl = 1, jpl 116 a_i (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 117 v_i (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 118 v_s (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 119 smv_i(i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 120 oa_i (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 121 ! 122 DO jj = j1, j2 123 DO ji = i1, i2 124 IF( ptab(ji,jj,jm) /= Agrif_SpecialValueFineGrid ) THEN 125 a_i (ji,jj,jl) = ptab(ji,jj,jm ) * tmask(ji,jj,1) 126 v_i (ji,jj,jl) = ptab(ji,jj,jm+1) * tmask(ji,jj,1) 127 v_s (ji,jj,jl) = ptab(ji,jj,jm+2) * tmask(ji,jj,1) 128 sv_i(ji,jj,jl) = ptab(ji,jj,jm+3) * tmask(ji,jj,1) 129 oa_i(ji,jj,jl) = ptab(ji,jj,jm+4) * tmask(ji,jj,1) 130 ENDIF 131 ENDDO 132 ENDDO 133 jm = jm + 5 134 ! 121 135 DO jk = 1, nlay_s 122 e_s(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 123 ENDDO 136 WHERE( ptab(i1:i2,j1:j2,jm) /= Agrif_SpecialValueFineGrid ) 137 e_s(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) 138 ENDWHERE 139 jm = jm + 1 140 ENDDO 141 ! 124 142 DO jk = 1, nlay_i 125 e_i(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 126 ENDDO 143 WHERE( ptab(i1:i2,j1:j2,jm) /= Agrif_SpecialValueFineGrid ) 144 e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) 145 ENDWHERE 146 jm = jm + 1 147 ENDDO 148 ! 127 149 ENDDO 128 150 ! 129 151 ! integrated values 130 152 vt_i (i1:i2,j1:j2) = SUM( v_i(i1:i2,j1:j2,:), dim=3 ) … … 154 176 zrhoy = Agrif_Rhoy() 155 177 ptab(:,:) = e2u(i1:i2,j1:j2) * u_ice(i1:i2,j1:j2) * zrhoy 156 WHERE( umask(i1:i2,j1:j2,1) == 0. ) ptab(:,:) = -9999.178 WHERE( umask(i1:i2,j1:j2,1) == 0. ) ptab(:,:) = Agrif_SpecialValueFineGrid 157 179 ELSE 158 u_ice(i1:i2,j1:j2) = ptab(:,:) / e2u(i1:i2,j1:j2) * umask(i1:i2,j1:j2,1) 180 WHERE( ptab(i1:i2,j1:j2) /= Agrif_SpecialValueFineGrid ) 181 u_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / e2u(i1:i2,j1:j2) * umask(i1:i2,j1:j2,1) 182 ENDWHERE 159 183 ENDIF 160 184 ! … … 177 201 zrhox = Agrif_Rhox() 178 202 ptab(:,:) = e1v(i1:i2,j1:j2) * v_ice(i1:i2,j1:j2) * zrhox 179 WHERE( vmask(i1:i2,j1:j2,1) == 0. ) ptab(:,:) = -9999.203 WHERE( vmask(i1:i2,j1:j2,1) == 0. ) ptab(:,:) = Agrif_SpecialValueFineGrid 180 204 ELSE 181 v_ice(i1:i2,j1:j2) = ptab(:,:) / e1v(i1:i2,j1:j2) * vmask(i1:i2,j1:j2,1) 205 WHERE( ptab(i1:i2,j1:j2) /= Agrif_SpecialValueFineGrid ) 206 v_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / e1v(i1:i2,j1:j2) * vmask(i1:i2,j1:j2,1) 207 ENDWHERE 182 208 ENDIF 183 209 ! -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
r8733 r8738 35 35 PUBLIC Agrif_tra, Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ssh_ts, Agrif_dta_ts 36 36 PUBLIC interpun, interpvn 37 PUBLIC interptsn, 37 PUBLIC interptsn, interpsshn 38 38 PUBLIC interpunb, interpvnb, interpub2b, interpvb2b 39 39 PUBLIC interpe3t, interpumsk, interpvmsk … … 100 100 IF( nbondi == +1 .OR. nbondi == 2 ) i2 = nlci-2 101 101 102 ! --- West --- ! 102 103 IF( nbondi == -1 .OR. nbondi == 2 ) THEN 103 104 ! 104 ! Smoothing105 ! ---------106 105 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 107 ua_b(2 ,:) = 0._wp106 ua_b(2:1+nbghostcells,:) = 0._wp 108 107 DO jk = 1, jpkm1 109 108 DO jj = 1, jpj 110 ua_b(2 ,jj) = ua_b(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk)109 ua_b(2:1+nbghostcells,jj) = ua_b(2:1+nbghostcells,jj) + e3u_a(2:1+nbghostcells,jj,jk) * ua(2:1+nbghostcells,jj,jk) 111 110 END DO 112 111 END DO 113 112 DO jj = 1, jpj 114 ua_b(2,jj) = ua_b(2,jj) * r1_hu_a(2,jj) 115 END DO 116 ENDIF 117 ! 118 DO jk=1,jpkm1 ! Smooth 119 DO jj=j1,j2 120 ua(2,jj,jk) = 0.25_wp*(ua(1,jj,jk)+2._wp*ua(2,jj,jk)+ua(3,jj,jk)) 121 ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk) 122 END DO 123 END DO 124 ! 125 zub(2,:) = 0._wp ! Correct transport 126 DO jk = 1, jpkm1 127 DO jj = 1, jpj 128 zub(2,jj) = zub(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk) 129 END DO 130 END DO 131 DO jj=1,jpj 132 zub(2,jj) = zub(2,jj) * r1_hu_a(2,jj) 133 END DO 134 135 DO jk=1,jpkm1 136 DO jj=1,jpj 137 ua(2,jj,jk) = (ua(2,jj,jk)+ua_b(2,jj)-zub(2,jj))*umask(2,jj,jk) 138 END DO 139 END DO 140 141 ! Set tangential velocities to time splitting estimate 142 !----------------------------------------------------- 143 IF( ln_dynspg_ts ) THEN 144 zvb(2,:) = 0._wp 113 ua_b(2:1+nbghostcells,jj) = ua_b(2:1+nbghostcells,jj) * r1_hu_a(2:1+nbghostcells,jj) 114 END DO 115 ENDIF 116 ! 117 ! Smoothing if only 1 ghostcell 118 ! ----------------------------- 119 IF( nbghostcells == 1 ) THEN 120 DO jk=1,jpkm1 ! Smooth 121 DO jj=j1,j2 122 ua(2,jj,jk) = 0.25_wp*(ua(1,jj,jk)+2._wp*ua(2,jj,jk)+ua(3,jj,jk)) 123 ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk) 124 END DO 125 END DO 126 ! 127 zub(2,:) = 0._wp ! Correct transport 145 128 DO jk = 1, jpkm1 146 129 DO jj = 1, jpj 147 zvb(2,jj) = zvb(2,jj) + e3v_a(2,jj,jk) * va(2,jj,jk) 148 END DO 149 END DO 150 DO jj = 1, jpj 151 zvb(2,jj) = zvb(2,jj) * r1_hv_a(2,jj) 152 END DO 130 zub(2,jj) = zub(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk) 131 END DO 132 END DO 133 DO jj=1,jpj 134 zub(2,jj) = zub(2,jj) * r1_hu_a(2,jj) 135 END DO 136 137 DO jk=1,jpkm1 138 DO jj=1,jpj 139 ua(2,jj,jk) = (ua(2,jj,jk)+ua_b(2,jj)-zub(2,jj))*umask(2,jj,jk) 140 END DO 141 END DO 142 143 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 144 zvb(2,:) = 0._wp 145 DO jk = 1, jpkm1 146 DO jj = 1, jpj 147 zvb(2,jj) = zvb(2,jj) + e3v_a(2,jj,jk) * va(2,jj,jk) 148 END DO 149 END DO 150 DO jj = 1, jpj 151 zvb(2,jj) = zvb(2,jj) * r1_hv_a(2,jj) 152 END DO 153 DO jk = 1, jpkm1 154 DO jj = 1, jpj 155 va(2,jj,jk) = (va(2,jj,jk)+va_b(2,jj)-zvb(2,jj)) * vmask(2,jj,jk) 156 END DO 157 END DO 158 ENDIF 159 ! 160 ENDIF 161 ! 162 ! Mask domain edges: 163 !------------------- 164 ! DO jk = 1, jpkm1 165 ! DO jj = 1, jpj 166 ! ua(1,jj,jk) = 0._wp 167 ! va(1,jj,jk) = 0._wp 168 ! END DO 169 ! END DO 170 ! 171 ENDIF 172 173 ! --- East --- ! 174 IF( nbondi == 1 .OR. nbondi == 2 ) THEN 175 176 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 177 ua_b(nlci-nbghostcells-1:nlci-2,:) = 0._wp 178 DO jk=1,jpkm1 179 DO jj=1,jpj 180 ua_b(nlci-nbghostcells-1:nlci-2,jj) = ua_b(nlci-nbghostcells-1:nlci-2,jj) + e3u_a(nlci-nbghostcells-1:nlci-2,jj,jk) & 181 & * ua(nlci-nbghostcells-1:nlci-2,jj,jk) 182 END DO 183 END DO 184 DO jj=1,jpj 185 ua_b(nlci-nbghostcells-1:nlci-2,jj) = ua_b(nlci-nbghostcells-1:nlci-2,jj) * r1_hu_a(nlci-nbghostcells-1:nlci-2,jj) 186 END DO 187 ENDIF 188 ! 189 ! Smoothing if only 1 ghostcell 190 ! ----------------------------- 191 IF( nbghostcells == 1 ) THEN 192 DO jk = 1, jpkm1 ! Smooth 193 DO jj = j1, j2 194 ua(nlci-2,jj,jk) = 0.25_wp * umask(nlci-2,jj,jk) & 195 & * ( ua(nlci-3,jj,jk) + 2._wp*ua(nlci-2,jj,jk) + ua(nlci-1,jj,jk) ) 196 END DO 197 END DO 198 199 zub(nlci-2,:) = 0._wp ! Correct transport 153 200 DO jk = 1, jpkm1 154 201 DO jj = 1, jpj 155 va(2,jj,jk) = (va(2,jj,jk)+va_b(2,jj)-zvb(2,jj)) * vmask(2,jj,jk) 156 END DO 157 END DO 202 zub(nlci-2,jj) = zub(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk) 203 END DO 204 END DO 205 DO jj = 1, jpj 206 zub(nlci-2,jj) = zub(nlci-2,jj) * r1_hu_a(nlci-2,jj) 207 END DO 208 209 DO jk = 1, jpkm1 210 DO jj = 1, jpj 211 ua(nlci-2,jj,jk) = ( ua(nlci-2,jj,jk) + ua_b(nlci-2,jj) - zub(nlci-2,jj) ) * umask(nlci-2,jj,jk) 212 END DO 213 END DO 214 ! 215 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 216 zvb(nlci-1,:) = 0._wp 217 DO jk = 1, jpkm1 218 DO jj = 1, jpj 219 zvb(nlci-1,jj) = zvb(nlci-1,jj) + e3v_a(nlci-1,jj,jk) * va(nlci-1,jj,jk) 220 END DO 221 END DO 222 DO jj=1,jpj 223 zvb(nlci-1,jj) = zvb(nlci-1,jj) * r1_hv_a(nlci-1,jj) 224 END DO 225 DO jk = 1, jpkm1 226 DO jj = 1, jpj 227 va(nlci-1,jj,jk) = ( va(nlci-1,jj,jk) + va_b(nlci-1,jj) - zvb(nlci-1,jj) ) * vmask(nlci-1,jj,jk) 228 END DO 229 END DO 230 ENDIF 231 ! 158 232 ENDIF 159 233 ! 160 234 ! Mask domain edges: 161 235 !------------------- 162 DO jk = 1, jpkm1 163 DO jj = 1, jpj 164 ua(1,jj,jk) = 0._wp 165 va(1,jj,jk) = 0._wp 166 END DO 167 END DO 168 ! 169 ENDIF 170 171 IF( nbondi == 1 .OR. nbondi == 2 ) THEN 172 173 ! Smoothing 174 ! --------- 236 ! DO jk = 1, jpkm1 237 ! DO jj = 1, jpj 238 ! ua(nlci-1,jj,jk) = 0._wp 239 ! va(nlci ,jj,jk) = 0._wp 240 ! END DO 241 ! END DO 242 ! 243 ENDIF 244 245 ! --- South --- ! 246 IF( nbondj == -1 .OR. nbondj == 2 ) THEN 247 175 248 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 176 ua_b(nlci-2,:) = 0._wp 249 va_b(:,2:nbghostcells+1) = 0._wp 250 DO jk = 1, jpkm1 251 DO ji = 1, jpi 252 va_b(ji,2:nbghostcells+1) = va_b(ji,2:nbghostcells+1) + e3v_a(ji,2:nbghostcells+1,jk) * va(ji,2:nbghostcells+1,jk) 253 END DO 254 END DO 255 DO ji=1,jpi 256 va_b(ji,2:nbghostcells+1) = va_b(ji,2:nbghostcells+1) * r1_hv_a(ji,2:nbghostcells+1) 257 END DO 258 ENDIF 259 ! 260 ! Smoothing if only 1 ghostcell 261 ! ----------------------------- 262 IF( nbghostcells == 1 ) THEN 263 DO jk = 1, jpkm1 ! Smooth 264 DO ji = i1, i2 265 va(ji,2,jk) = 0.25_wp * vmask(ji,2,jk) & 266 & * ( va(ji,1,jk) + 2._wp*va(ji,2,jk) + va(ji,3,jk) ) 267 END DO 268 END DO 269 ! 270 zvb(:,2) = 0._wp ! Correct transport 177 271 DO jk=1,jpkm1 178 DO jj=1,jpj 179 ua_b(nlci-2,jj) = ua_b(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk) 180 END DO 181 END DO 182 DO jj=1,jpj 183 ua_b(nlci-2,jj) = ua_b(nlci-2,jj) * r1_hu_a(nlci-2,jj) 184 END DO 185 ENDIF 186 187 DO jk = 1, jpkm1 ! Smooth 188 DO jj = j1, j2 189 ua(nlci-2,jj,jk) = 0.25_wp * umask(nlci-2,jj,jk) & 190 & * ( ua(nlci-3,jj,jk) + 2._wp*ua(nlci-2,jj,jk) + ua(nlci-1,jj,jk) ) 191 END DO 192 END DO 193 194 zub(nlci-2,:) = 0._wp ! Correct transport 195 DO jk = 1, jpkm1 196 DO jj = 1, jpj 197 zub(nlci-2,jj) = zub(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk) 198 END DO 199 END DO 200 DO jj = 1, jpj 201 zub(nlci-2,jj) = zub(nlci-2,jj) * r1_hu_a(nlci-2,jj) 202 END DO 203 204 DO jk = 1, jpkm1 205 DO jj = 1, jpj 206 ua(nlci-2,jj,jk) = ( ua(nlci-2,jj,jk) + ua_b(nlci-2,jj) - zub(nlci-2,jj) ) * umask(nlci-2,jj,jk) 207 END DO 208 END DO 209 ! 210 ! Set tangential velocities to time splitting estimate 211 !----------------------------------------------------- 212 IF( ln_dynspg_ts ) THEN 213 zvb(nlci-1,:) = 0._wp 272 DO ji=1,jpi 273 zvb(ji,2) = zvb(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk) * vmask(ji,2,jk) 274 END DO 275 END DO 276 DO ji = 1, jpi 277 zvb(ji,2) = zvb(ji,2) * r1_hv_a(ji,2) 278 END DO 214 279 DO jk = 1, jpkm1 215 DO jj = 1, jpj 216 zvb(nlci-1,jj) = zvb(nlci-1,jj) + e3v_a(nlci-1,jj,jk) * va(nlci-1,jj,jk) 217 END DO 218 END DO 219 DO jj=1,jpj 220 zvb(nlci-1,jj) = zvb(nlci-1,jj) * r1_hv_a(nlci-1,jj) 221 END DO 222 DO jk = 1, jpkm1 223 DO jj = 1, jpj 224 va(nlci-1,jj,jk) = ( va(nlci-1,jj,jk) + va_b(nlci-1,jj) - zvb(nlci-1,jj) ) * vmask(nlci-1,jj,jk) 225 END DO 226 END DO 280 DO ji = 1, jpi 281 va(ji,2,jk) = ( va(ji,2,jk) + va_b(ji,2) - zvb(ji,2) ) * vmask(ji,2,jk) 282 END DO 283 END DO 284 285 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 286 zub(:,2) = 0._wp 287 DO jk = 1, jpkm1 288 DO ji = 1, jpi 289 zub(ji,2) = zub(ji,2) + e3u_a(ji,2,jk) * ua(ji,2,jk) * umask(ji,2,jk) 290 END DO 291 END DO 292 DO ji = 1, jpi 293 zub(ji,2) = zub(ji,2) * r1_hu_a(ji,2) 294 END DO 295 296 DO jk = 1, jpkm1 297 DO ji = 1, jpi 298 ua(ji,2,jk) = ( ua(ji,2,jk) + ua_b(ji,2) - zub(ji,2) ) * umask(ji,2,jk) 299 END DO 300 END DO 301 ENDIF 302 ! 227 303 ENDIF 228 304 ! 229 305 ! Mask domain edges: 230 306 !------------------- 231 DO jk = 1, jpkm1 232 DO jj = 1, jpj 233 ua(nlci-1,jj,jk) = 0._wp 234 va(nlci ,jj,jk) = 0._wp 235 END DO 236 END DO 237 ! 238 ENDIF 239 240 IF( nbondj == -1 .OR. nbondj == 2 ) THEN 241 242 ! Smoothing 243 ! --------- 307 ! DO jk = 1, jpkm1 308 ! DO ji = 1, jpi 309 ! ua(ji,1,jk) = 0._wp 310 ! va(ji,1,jk) = 0._wp 311 ! END DO 312 ! END DO 313 ! 314 ENDIF 315 316 ! --- North --- ! 317 IF( nbondj == 1 .OR. nbondj == 2 ) THEN 318 ! 244 319 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 245 va_b(:, 2) = 0._wp320 va_b(:,nlcj-nbghostcells-1:nlcj-2) = 0._wp 246 321 DO jk = 1, jpkm1 247 322 DO ji = 1, jpi 248 va_b(ji,2) = va_b(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk) 249 END DO 250 END DO 251 DO ji=1,jpi 252 va_b(ji,2) = va_b(ji,2) * r1_hv_a(ji,2) 253 END DO 254 ENDIF 255 ! 256 DO jk = 1, jpkm1 ! Smooth 257 DO ji = i1, i2 258 va(ji,2,jk) = 0.25_wp * vmask(ji,2,jk) & 259 & * ( va(ji,1,jk) + 2._wp*va(ji,2,jk) + va(ji,3,jk) ) 260 END DO 261 END DO 262 ! 263 zvb(:,2) = 0._wp ! Correct transport 264 DO jk=1,jpkm1 265 DO ji=1,jpi 266 zvb(ji,2) = zvb(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk) * vmask(ji,2,jk) 267 END DO 268 END DO 269 DO ji = 1, jpi 270 zvb(ji,2) = zvb(ji,2) * r1_hv_a(ji,2) 271 END DO 272 DO jk = 1, jpkm1 323 va_b(ji,nlcj-nbghostcells-1:nlcj-2) = va_b(ji,nlcj-nbghostcells-1:nlcj-2) + e3v_a(ji,nlcj-nbghostcells-1:nlcj-2,jk) & 324 & * va(ji,nlcj-nbghostcells-1:nlcj-2,jk) 325 END DO 326 END DO 273 327 DO ji = 1, jpi 274 va(ji,2,jk) = ( va(ji,2,jk) + va_b(ji,2) - zvb(ji,2) ) * vmask(ji,2,jk) 275 END DO 276 END DO 277 278 ! Set tangential velocities to time splitting estimate 279 !----------------------------------------------------- 280 IF( ln_dynspg_ts ) THEN 281 zub(:,2) = 0._wp 328 va_b(ji,nlcj-nbghostcells-1:nlcj-2) = va_b(ji,nlcj-nbghostcells-1:nlcj-2) * r1_hv_a(ji,nlcj-nbghostcells-1:nlcj-2) 329 END DO 330 ENDIF 331 ! 332 ! Smoothing if only 1 ghostcell 333 ! ----------------------------- 334 IF( nbghostcells == 1 ) THEN 335 DO jk = 1, jpkm1 ! Smooth 336 DO ji = i1, i2 337 va(ji,nlcj-2,jk) = 0.25_wp * vmask(ji,nlcj-2,jk) & 338 & * ( va(ji,nlcj-3,jk) + 2._wp * va(ji,nlcj-2,jk) + va(ji,nlcj-1,jk) ) 339 END DO 340 END DO 341 ! 342 zvb(:,nlcj-2) = 0._wp ! Correct transport 282 343 DO jk = 1, jpkm1 283 344 DO ji = 1, jpi 284 z ub(ji,2) = zub(ji,2) + e3u_a(ji,2,jk) * ua(ji,2,jk) * umask(ji,2,jk)345 zvb(ji,nlcj-2) = zvb(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk) 285 346 END DO 286 347 END DO 287 348 DO ji = 1, jpi 288 zub(ji,2) = zub(ji,2) * r1_hu_a(ji,2) 289 END DO 290 349 zvb(ji,nlcj-2) = zvb(ji,nlcj-2) * r1_hv_a(ji,nlcj-2) 350 END DO 291 351 DO jk = 1, jpkm1 292 352 DO ji = 1, jpi 293 ua(ji,2,jk) = ( ua(ji,2,jk) + ua_b(ji,2) - zub(ji,2) ) * umask(ji,2,jk) 294 END DO 295 END DO 296 ENDIF 297 353 va(ji,nlcj-2,jk) = ( va(ji,nlcj-2,jk) + va_b(ji,nlcj-2) - zvb(ji,nlcj-2) ) * vmask(ji,nlcj-2,jk) 354 END DO 355 END DO 356 ! 357 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 358 zub(:,nlcj-1) = 0._wp 359 DO jk = 1, jpkm1 360 DO ji = 1, jpi 361 zub(ji,nlcj-1) = zub(ji,nlcj-1) + e3u_a(ji,nlcj-1,jk) * ua(ji,nlcj-1,jk) * umask(ji,nlcj-1,jk) 362 END DO 363 END DO 364 DO ji = 1, jpi 365 zub(ji,nlcj-1) = zub(ji,nlcj-1) * r1_hu_a(ji,nlcj-1) 366 END DO 367 ! 368 DO jk = 1, jpkm1 369 DO ji = 1, jpi 370 ua(ji,nlcj-1,jk) = ( ua(ji,nlcj-1,jk) + ua_b(ji,nlcj-1) - zub(ji,nlcj-1) ) * umask(ji,nlcj-1,jk) 371 END DO 372 END DO 373 ENDIF 374 ! 375 ENDIF 376 ! 298 377 ! Mask domain edges: 299 378 !------------------- 300 DO jk = 1, jpkm1 301 DO ji = 1, jpi 302 ua(ji,1,jk) = 0._wp 303 va(ji,1,jk) = 0._wp 304 END DO 305 END DO 306 307 ENDIF 308 309 IF( nbondj == 1 .OR. nbondj == 2 ) THEN 310 ! 311 ! Smoothing 312 ! --------- 313 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 314 va_b(:,nlcj-2) = 0._wp 315 DO jk = 1, jpkm1 316 DO ji = 1, jpi 317 va_b(ji,nlcj-2) = va_b(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk) 318 END DO 319 END DO 320 DO ji = 1, jpi 321 va_b(ji,nlcj-2) = va_b(ji,nlcj-2) * r1_hv_a(ji,nlcj-2) 322 END DO 323 ENDIF 324 ! 325 DO jk = 1, jpkm1 ! Smooth 326 DO ji = i1, i2 327 va(ji,nlcj-2,jk) = 0.25_wp * vmask(ji,nlcj-2,jk) & 328 & * ( va(ji,nlcj-3,jk) + 2._wp * va(ji,nlcj-2,jk) + va(ji,nlcj-1,jk) ) 329 END DO 330 END DO 331 ! 332 zvb(:,nlcj-2) = 0._wp ! Correct transport 333 DO jk = 1, jpkm1 334 DO ji = 1, jpi 335 zvb(ji,nlcj-2) = zvb(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk) 336 END DO 337 END DO 338 DO ji = 1, jpi 339 zvb(ji,nlcj-2) = zvb(ji,nlcj-2) * r1_hv_a(ji,nlcj-2) 340 END DO 341 DO jk = 1, jpkm1 342 DO ji = 1, jpi 343 va(ji,nlcj-2,jk) = ( va(ji,nlcj-2,jk) + va_b(ji,nlcj-2) - zvb(ji,nlcj-2) ) * vmask(ji,nlcj-2,jk) 344 END DO 345 END DO 346 ! 347 ! Set tangential velocities to time splitting estimate 348 !----------------------------------------------------- 349 IF( ln_dynspg_ts ) THEN 350 zub(:,nlcj-1) = 0._wp 351 DO jk = 1, jpkm1 352 DO ji = 1, jpi 353 zub(ji,nlcj-1) = zub(ji,nlcj-1) + e3u_a(ji,nlcj-1,jk) * ua(ji,nlcj-1,jk) * umask(ji,nlcj-1,jk) 354 END DO 355 END DO 356 DO ji = 1, jpi 357 zub(ji,nlcj-1) = zub(ji,nlcj-1) * r1_hu_a(ji,nlcj-1) 358 END DO 359 ! 360 DO jk = 1, jpkm1 361 DO ji = 1, jpi 362 ua(ji,nlcj-1,jk) = ( ua(ji,nlcj-1,jk) + ua_b(ji,nlcj-1) - zub(ji,nlcj-1) ) * umask(ji,nlcj-1,jk) 363 END DO 364 END DO 365 ENDIF 366 ! 367 ! Mask domain edges: 368 !------------------- 369 DO jk = 1, jpkm1 370 DO ji = 1, jpi 371 ua(ji,nlcj ,jk) = 0._wp 372 va(ji,nlcj-1,jk) = 0._wp 373 END DO 374 END DO 379 ! DO jk = 1, jpkm1 380 ! DO ji = 1, jpi 381 ! ua(ji,nlcj ,jk) = 0._wp 382 ! va(ji,nlcj-1,jk) = 0._wp 383 ! END DO 384 ! END DO 375 385 ! 376 386 ENDIF … … 392 402 ! 393 403 IF( Agrif_Root() ) RETURN 394 ! 404 !! clem ghost 395 405 IF((nbondi == -1).OR.(nbondi == 2)) THEN 396 406 DO jj=1,jpj 397 va_e(2 ,jj) = vbdy_w(jj) * hvr_e(2,jj)407 va_e(2:nbghostcells+1,jj) = vbdy_w(jj) * hvr_e(2:nbghostcells+1,jj) 398 408 ! Specified fluxes: 399 ua_e(2 ,jj) = ubdy_w(jj) * hur_e(2,jj)400 ! Characteristics method :409 ua_e(2:nbghostcells+1,jj) = ubdy_w(jj) * hur_e(2:nbghostcells+1,jj) 410 ! Characteristics method (only if ghostcells=1): 401 411 !alt ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) & 402 412 !alt & - sqrt(grav * hur_e(2,jj)) * (sshn_e(3,jj) - hbdy_w(jj)) ) … … 406 416 IF((nbondi == 1).OR.(nbondi == 2)) THEN 407 417 DO jj=1,jpj 408 va_e(nlci- 1,jj) = vbdy_e(jj) * hvr_e(nlci-1,jj)418 va_e(nlci-nbghostcells:nlci-1,jj) = vbdy_e(jj) * hvr_e(nlci-nbghostcells:nlci-1,jj) 409 419 ! Specified fluxes: 410 ua_e(nlci- 2,jj) = ubdy_e(jj) * hur_e(nlci-2,jj)411 ! Characteristics method :420 ua_e(nlci-nbghostcells-1:nlci-2,jj) = ubdy_e(jj) * hur_e(nlci-nbghostcells-1:nlci-2,jj) 421 ! Characteristics method (only if ghostcells=1): 412 422 !alt ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) & 413 423 !alt & + sqrt(grav * hur_e(nlci-2,jj)) * (sshn_e(nlci-2,jj) - hbdy_e(jj)) ) … … 417 427 IF((nbondj == -1).OR.(nbondj == 2)) THEN 418 428 DO ji=1,jpi 419 ua_e(ji,2 ) = ubdy_s(ji) * hur_e(ji,2)429 ua_e(ji,2:nbghostcells+1) = ubdy_s(ji) * hur_e(ji,2:nbghostcells+1) 420 430 ! Specified fluxes: 421 va_e(ji,2 ) = vbdy_s(ji) * hvr_e(ji,2)422 ! Characteristics method :431 va_e(ji,2:nbghostcells+1) = vbdy_s(ji) * hvr_e(ji,2:nbghostcells+1) 432 ! Characteristics method (only if ghostcells=1): 423 433 !alt va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) & 424 434 !alt & - sqrt(grav * hvr_e(ji,2)) * (sshn_e(ji,3) - hbdy_s(ji)) ) … … 428 438 IF((nbondj == 1).OR.(nbondj == 2)) THEN 429 439 DO ji=1,jpi 430 ua_e(ji,nlcj- 1) = ubdy_n(ji) * hur_e(ji,nlcj-1)440 ua_e(ji,nlcj-nbghostcells:nlcj-1) = ubdy_n(ji) * hur_e(ji,nlcj-nbghostcells:nlcj-1) 431 441 ! Specified fluxes: 432 va_e(ji,nlcj- 2) = vbdy_n(ji) * hvr_e(ji,nlcj-2)433 ! Characteristics method :442 va_e(ji,nlcj-nbghostcells-1:nlcj-2) = vbdy_n(ji) * hvr_e(ji,nlcj-nbghostcells-1:nlcj-2) 443 ! Characteristics method (only if ghostcells=1): 434 444 !alt va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2) + va_e(ji,nlcj-3) & 435 445 !alt & + sqrt(grav * hvr_e(ji,nlcj-2)) * (sshn_e(ji,nlcj-2) - hbdy_n(ji)) ) … … 476 486 ! 477 487 IF( ll_int_cons ) THEN ! Conservative interpolation 478 ! order smatters here !!!!!!488 ! order matters here !!!!!! 479 489 CALL Agrif_Bc_variable( ub2b_interp_id, calledweight=1._wp, procname=interpub2b ) ! Time integrated 480 490 CALL Agrif_Bc_variable( vb2b_interp_id, calledweight=1._wp, procname=interpvb2b ) … … 504 514 !!---------------------------------------------------------------------- 505 515 INTEGER, INTENT(in) :: kt 506 !! 516 ! 517 INTEGER :: ji, jj, indx 507 518 !!---------------------------------------------------------------------- 508 519 ! 509 520 IF( Agrif_Root() ) RETURN 510 ! 521 !! clem ghost 522 ! --- West --- ! 511 523 IF((nbondi == -1).OR.(nbondi == 2)) THEN 512 ssha(2,:)=ssha(3,:) 513 sshn(2,:)=sshn(3,:) 514 ENDIF 515 ! 524 indx = 1+nbghostcells 525 DO jj = 1, jpj 526 DO ji = 2, indx 527 ssha(ji,jj)=ssha(indx+1,jj) 528 sshn(ji,jj)=sshn(indx+1,jj) 529 ENDDO 530 ENDDO 531 ENDIF 532 ! 533 ! --- East --- ! 516 534 IF((nbondi == 1).OR.(nbondi == 2)) THEN 517 ssha(nlci-1,:)=ssha(nlci-2,:) 518 sshn(nlci-1,:)=sshn(nlci-2,:) 519 ENDIF 520 ! 535 indx = nlci-nbghostcells 536 DO jj = 1, jpj 537 DO ji = indx, nlci-1 538 ssha(ji,jj)=ssha(indx-1,jj) 539 sshn(ji,jj)=sshn(indx-1,jj) 540 ENDDO 541 ENDDO 542 ENDIF 543 ! 544 ! --- South --- ! 521 545 IF((nbondj == -1).OR.(nbondj == 2)) THEN 522 ssha(:,2)=ssha(:,3) 523 sshn(:,2)=sshn(:,3) 524 ENDIF 525 ! 546 indx = 1+nbghostcells 547 DO jj = 2, indx 548 DO ji = 1, jpi 549 ssha(ji,jj)=ssha(ji,indx+1) 550 sshn(ji,jj)=sshn(ji,indx+1) 551 ENDDO 552 ENDDO 553 ENDIF 554 ! 555 ! --- North --- ! 526 556 IF((nbondj == 1).OR.(nbondj == 2)) THEN 527 ssha(:,nlcj-1)=ssha(:,nlcj-2) 528 sshn(:,nlcj-1)=sshn(:,nlcj-2) 557 indx = nlcj-nbghostcells 558 DO jj = indx, nlcj-1 559 DO ji = 1, jpi 560 ssha(ji,jj)=ssha(ji,indx-1) 561 sshn(ji,jj)=sshn(ji,indx-1) 562 ENDDO 563 ENDDO 529 564 ENDIF 530 565 ! … … 538 573 INTEGER, INTENT(in) :: jn 539 574 !! 540 INTEGER :: ji, jj541 !!---------------------------------------------------------------------- 542 ! 575 INTEGER :: ji, jj 576 !!---------------------------------------------------------------------- 577 !! clem ghost (starting at i,j=1 is important I think otherwise you introduce a grad(ssh)/=0 at point 2) 543 578 IF((nbondi == -1).OR.(nbondi == 2)) THEN 544 579 DO jj = 1, jpj 545 ssha_e(2 ,jj) = hbdy_w(jj)580 ssha_e(2:nbghostcells+1,jj) = hbdy_w(jj) 546 581 END DO 547 582 ENDIF … … 549 584 IF((nbondi == 1).OR.(nbondi == 2)) THEN 550 585 DO jj = 1, jpj 551 ssha_e(nlci- 1,jj) = hbdy_e(jj)586 ssha_e(nlci-nbghostcells:nlci-1,jj) = hbdy_e(jj) 552 587 END DO 553 588 ENDIF … … 555 590 IF((nbondj == -1).OR.(nbondj == 2)) THEN 556 591 DO ji = 1, jpi 557 ssha_e(ji,2 ) = hbdy_s(ji)592 ssha_e(ji,2:nbghostcells+1) = hbdy_s(ji) 558 593 END DO 559 594 ENDIF … … 561 596 IF((nbondj == 1).OR.(nbondj == 2)) THEN 562 597 DO ji = 1, jpi 563 ssha_e(ji,nlcj- 1) = hbdy_n(ji)598 ssha_e(ji,nlcj-nbghostcells:nlcj-1) = hbdy_n(ji) 564 599 END DO 565 600 ENDIF … … 601 636 INTEGER :: ji, jj, jk, jn ! dummy loop indices 602 637 INTEGER :: imin, imax, jmin, jmax 603 REAL(wp) :: zrhox , zalpha1, zalpha2, zalpha3 604 REAL(wp) :: zalpha4, zalpha5, zalpha6, zalpha7 638 REAL(wp) :: zrhox, z1, z2, z3, z4, z5, z6, z7 605 639 LOGICAL :: western_side, eastern_side,northern_side,southern_side 606 640 !!---------------------------------------------------------------------- … … 610 644 ELSE 611 645 ! 612 western_side = (nb == 1).AND.(ndir == 1) 613 eastern_side = (nb == 1).AND.(ndir == 2) 614 southern_side = (nb == 2).AND.(ndir == 1) 615 northern_side = (nb == 2).AND.(ndir == 2) 616 ! 617 zrhox = Agrif_Rhox() 618 ! 619 zalpha1 = ( zrhox - 1. ) * 0.5 620 zalpha2 = 1. - zalpha1 621 ! 622 zalpha3 = ( zrhox - 1. ) / ( zrhox + 1. ) 623 zalpha4 = 1. - zalpha3 624 ! 625 zalpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 626 zalpha7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 627 zalpha5 = 1. - zalpha6 - zalpha7 628 ! 629 imin = i1 630 imax = i2 631 jmin = j1 632 jmax = j2 633 ! 634 ! Remove CORNERS 635 IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3 636 IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2 637 IF((nbondi == -1).OR.(nbondi == 2)) imin = 3 638 IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2 639 ! 640 IF( eastern_side ) THEN 641 DO jn = 1, jpts 642 tsa(nlci,j1:j2,k1:k2,jn) = zalpha1 * ptab(nlci,j1:j2,k1:k2,jn) + zalpha2 * ptab(nlci-1,j1:j2,k1:k2,jn) 643 DO jk = 1, jpkm1 644 DO jj = jmin,jmax 645 IF( umask(nlci-2,jj,jk) == 0._wp ) THEN 646 tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 647 ELSE 648 tsa(nlci-1,jj,jk,jn)=(zalpha4*tsa(nlci,jj,jk,jn)+zalpha3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 649 IF( un(nlci-2,jj,jk) > 0._wp ) THEN 650 tsa(nlci-1,jj,jk,jn)=( zalpha6*tsa(nlci-2,jj,jk,jn)+zalpha5*tsa(nlci,jj,jk,jn) & 651 + zalpha7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 646 western_side = (nb == 1).AND.(ndir == 1) ; eastern_side = (nb == 1).AND.(ndir == 2) 647 southern_side = (nb == 2).AND.(ndir == 1) ; northern_side = (nb == 2).AND.(ndir == 2) 648 ! 649 IF( nbghostcells > 1 ) THEN ! no smoothing 650 tsa(i1:i2,j1:j2,k1:k2,n1:n2) = ptab(i1:i2,j1:j2,k1:k2,n1:n2) 651 ELSE ! smoothing 652 ! 653 zrhox = Agrif_Rhox() 654 z1 = ( zrhox - 1. ) * 0.5 655 z3 = ( zrhox - 1. ) / ( zrhox + 1. ) 656 z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 657 z7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 658 ! 659 z2 = 1. - z1 660 z4 = 1. - z3 661 z5 = 1. - z6 - z7 662 ! 663 imin = i1 ; imax = i2 664 jmin = j1 ; jmax = j2 665 ! 666 ! Remove CORNERS 667 IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3 668 IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2 669 IF((nbondi == -1).OR.(nbondi == 2)) imin = 3 670 IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2 671 ! 672 IF( eastern_side ) THEN 673 DO jn = 1, jpts 674 tsa(nlci,j1:j2,k1:k2,jn) = z1 * ptab(nlci,j1:j2,k1:k2,jn) + z2 * ptab(nlci-1,j1:j2,k1:k2,jn) 675 DO jk = 1, jpkm1 676 DO jj = jmin,jmax 677 IF( umask(nlci-2,jj,jk) == 0._wp ) THEN 678 tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 679 ELSE 680 tsa(nlci-1,jj,jk,jn)=(z4*tsa(nlci,jj,jk,jn)+z3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 681 IF( un(nlci-2,jj,jk) > 0._wp ) THEN 682 tsa(nlci-1,jj,jk,jn)=( z6*tsa(nlci-2,jj,jk,jn)+z5*tsa(nlci,jj,jk,jn) & 683 + z7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 684 ENDIF 652 685 ENDIF 653 END IF686 END DO 654 687 END DO 655 END DO656 tsa(nlci,j1:j2,k1:k2,jn) = 0._wp657 END DO658 ENDIF659 !660 IF( northern_side ) THEN661 DO jn = 1, jpts662 tsa(i1:i2,nlcj,k1:k2,jn) = zalpha1 * ptab(i1:i2,nlcj,k1:k2,jn) + zalpha2 * ptab(i1:i2,nlcj-1,k1:k2,jn)663 DO jk = 1, jpkm1664 DO ji = imin,imax665 IF( vmask(ji,nlcj-2,jk) == 0._wp ) THEN666 tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)667 ELSE668 tsa(ji,nlcj-1,jk,jn)=(zalpha4*tsa(ji,nlcj,jk,jn)+zalpha3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)669 IF (vn(ji,nlcj-2,jk) > 0._wp ) THEN670 tsa(ji,nlcj-1,jk,jn)=( zalpha6*tsa(ji,nlcj-2,jk,jn)+zalpha5*tsa(ji,nlcj,jk,jn) &671 + zalpha7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)688 tsa(nlci,j1:j2,k1:k2,jn) = 0._wp 689 END DO 690 ENDIF 691 ! 692 IF( northern_side ) THEN 693 DO jn = 1, jpts 694 tsa(i1:i2,nlcj,k1:k2,jn) = z1 * ptab(i1:i2,nlcj,k1:k2,jn) + z2 * 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._wp ) 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)=(z4*tsa(ji,nlcj,jk,jn)+z3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk) 701 IF (vn(ji,nlcj-2,jk) > 0._wp ) THEN 702 tsa(ji,nlcj-1,jk,jn)=( z6*tsa(ji,nlcj-2,jk,jn)+z5*tsa(ji,nlcj,jk,jn) & 703 + z7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 704 ENDIF 672 705 ENDIF 673 END IF706 END DO 674 707 END DO 675 END DO676 tsa(i1:i2,nlcj,k1:k2,jn) = 0._wp677 END DO678 ENDIF679 !680 IF( western_side ) THEN681 DO jn = 1, jpts682 tsa(1,j1:j2,k1:k2,jn) = zalpha1 * ptab(1,j1:j2,k1:k2,jn) + zalpha2 * ptab(2,j1:j2,k1:k2,jn)683 DO jk = 1, jpkm1684 DO jj = jmin,jmax685 IF( umask(2,jj,jk) == 0._wp ) THEN686 tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk)687 ELSE688 tsa(2,jj,jk,jn)=(zalpha4*tsa(1,jj,jk,jn)+zalpha3*tsa(3,jj,jk,jn))*tmask(2,jj,jk)689 IF( un(2,jj,jk) < 0._wp ) THEN690 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)708 tsa(i1:i2,nlcj,k1:k2,jn) = 0._wp 709 END DO 710 ENDIF 711 ! 712 IF( western_side ) THEN 713 DO jn = 1, jpts 714 tsa(1,j1:j2,k1:k2,jn) = z1 * ptab(1,j1:j2,k1:k2,jn) + z2 * ptab(2,j1:j2,k1:k2,jn) 715 DO jk = 1, jpkm1 716 DO jj = jmin,jmax 717 IF( umask(2,jj,jk) == 0._wp ) THEN 718 tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk) 719 ELSE 720 tsa(2,jj,jk,jn)=(z4*tsa(1,jj,jk,jn)+z3*tsa(3,jj,jk,jn))*tmask(2,jj,jk) 721 IF( un(2,jj,jk) < 0._wp ) THEN 722 tsa(2,jj,jk,jn)=(z6*tsa(3,jj,jk,jn)+z5*tsa(1,jj,jk,jn)+z7*tsa(4,jj,jk,jn))*tmask(2,jj,jk) 723 ENDIF 691 724 ENDIF 692 END IF725 END DO 693 726 END DO 694 END DO695 tsa(1,j1:j2,k1:k2,jn) = 0._wp696 END DO697 ENDIF698 !699 IF( southern_side ) THEN700 DO jn = 1, jpts701 tsa(i1:i2,1,k1:k2,jn) = zalpha1 * ptab(i1:i2,1,k1:k2,jn) + zalpha2 * ptab(i1:i2,2,k1:k2,jn)702 DO jk = 1, jpk703 DO ji=imin,imax704 IF( vmask(ji,2,jk) == 0._wp ) THEN705 tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk)706 ELSE707 tsa(ji,2,jk,jn)=(zalpha4*tsa(ji,1,jk,jn)+zalpha3*tsa(ji,3,jk,jn))*tmask(ji,2,jk)708 IF( vn(ji,2,jk) < 0._wp ) THEN709 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)727 tsa(1,j1:j2,k1:k2,jn) = 0._wp 728 END DO 729 ENDIF 730 ! 731 IF( southern_side ) THEN 732 DO jn = 1, jpts 733 tsa(i1:i2,1,k1:k2,jn) = z1 * ptab(i1:i2,1,k1:k2,jn) + z2 * ptab(i1:i2,2,k1:k2,jn) 734 DO jk = 1, jpk 735 DO ji=imin,imax 736 IF( vmask(ji,2,jk) == 0._wp ) THEN 737 tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk) 738 ELSE 739 tsa(ji,2,jk,jn)=(z4*tsa(ji,1,jk,jn)+z3*tsa(ji,3,jk,jn))*tmask(ji,2,jk) 740 IF( vn(ji,2,jk) < 0._wp ) THEN 741 tsa(ji,2,jk,jn)=(z6*tsa(ji,3,jk,jn)+z5*tsa(ji,1,jk,jn)+z7*tsa(ji,4,jk,jn))*tmask(ji,2,jk) 742 ENDIF 710 743 ENDIF 711 END IF744 END DO 712 745 END DO 713 END DO 714 tsa(i1:i2,1,k1:k2,jn) = 0._wp 715 END DO 716 ENDIF 717 ! 718 ! Treatment of corners 719 ! 720 ! East south 721 IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN 722 tsa(nlci-1,2,:,:) = ptab(nlci-1,2,:,:) 723 ENDIF 724 ! East north 725 IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN 726 tsa(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:) 727 ENDIF 728 ! West south 729 IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN 730 tsa(2,2,:,:) = ptab(2,2,:,:) 731 ENDIF 732 ! West north 733 IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN 734 tsa(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:) 735 ENDIF 736 ! 746 tsa(i1:i2,1,k1:k2,jn) = 0._wp 747 END DO 748 ENDIF 749 ! 750 ! Treatment of corners 751 IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) tsa(nlci-1,2,:,:) = ptab(nlci-1,2,:,:) ! East south 752 IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) tsa(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:) ! East north 753 IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) tsa(2,2,:,:) = ptab(2,2,:,:) ! West south 754 IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) tsa(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:) ! West north 755 ! 756 ENDIF 737 757 ENDIF 738 758 ! … … 759 779 southern_side = (nb == 2).AND.(ndir == 1) 760 780 northern_side = (nb == 2).AND.(ndir == 2) 761 IF(western_side) hbdy_w(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1) 762 IF(eastern_side) hbdy_e(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1) 763 IF(southern_side) hbdy_s(i1:i2) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1) 781 !! clem ghost 782 IF(western_side) hbdy_w(j1:j2) = ptab(i2,j1:j2) * tmask(i2,j1:j2,1) 783 IF(eastern_side) hbdy_e(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1) !clem previously i1 784 IF(southern_side) hbdy_s(i1:i2) = ptab(i1:i2,j2) * tmask(i1:i2,j2,1) !clem previously j1 764 785 IF(northern_side) hbdy_n(i1:i2) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1) 765 786 ENDIF … … 854 875 ELSEIF( bdy_tinterp == 2 ) THEN 855 876 ztcoeff = zrhot * ( zt1 * ( zt1 - 1._wp)**2._wp & 856 & - zt0 * ( zt0 - 1._wp)**2._wp ) 857 877 & - zt0 * ( zt0 - 1._wp)**2._wp ) 858 878 ELSE 859 879 ztcoeff = 1 860 880 ENDIF 861 ! 862 IF(western_side) THEN 863 ubdy_w(j1:j2) = ubdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2) 864 ENDIF 865 IF(eastern_side) THEN 866 ubdy_e(j1:j2) = ubdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2) 867 ENDIF 868 IF(southern_side) THEN 869 ubdy_s(i1:i2) = ubdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j1) 870 ENDIF 871 IF(northern_side) THEN 872 ubdy_n(i1:i2) = ubdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 873 ENDIF 881 !! clem ghost 882 IF(western_side) ubdy_w(j1:j2) = ubdy_w(j1:j2) + ztcoeff * ptab(i2,j1:j2) 883 IF(eastern_side) ubdy_e(j1:j2) = ubdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2) !clem previously i1 884 IF(southern_side) ubdy_s(i1:i2) = ubdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j2) !clem previously j1 885 IF(northern_side) ubdy_n(i1:i2) = ubdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 874 886 ! 875 887 IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 876 IF(western_side) THEN 877 ubdy_w(j1:j2) = ubdy_w(j1:j2) / (zrhoy*e2u(i1,j1:j2)) * umask(i1,j1:j2,1) 878 ENDIF 879 IF(eastern_side) THEN 880 ubdy_e(j1:j2) = ubdy_e(j1:j2) / (zrhoy*e2u(i1,j1:j2)) * umask(i1,j1:j2,1) 881 ENDIF 882 IF(southern_side) THEN 883 ubdy_s(i1:i2) = ubdy_s(i1:i2) / (zrhoy*e2u(i1:i2,j1)) * umask(i1:i2,j1,1) 884 ENDIF 885 IF(northern_side) THEN 886 ubdy_n(i1:i2) = ubdy_n(i1:i2) / (zrhoy*e2u(i1:i2,j1)) * umask(i1:i2,j1,1) 887 ENDIF 888 IF(western_side) ubdy_w(j1:j2) = ubdy_w(j1:j2) / (zrhoy*e2u(i2,j1:j2)) * umask(i2,j1:j2,1) 889 IF(eastern_side) ubdy_e(j1:j2) = ubdy_e(j1:j2) / (zrhoy*e2u(i1,j1:j2)) * umask(i1,j1:j2,1) 890 IF(southern_side) ubdy_s(i1:i2) = ubdy_s(i1:i2) / (zrhoy*e2u(i1:i2,j2)) * umask(i1:i2,j2,1) 891 IF(northern_side) ubdy_n(i1:i2) = ubdy_n(i1:i2) / (zrhoy*e2u(i1:i2,j1)) * umask(i1:i2,j1,1) 888 892 ENDIF 889 893 ENDIF … … 927 931 ztcoeff = 1 928 932 ENDIF 929 ! 930 IF(western_side) THEN 931 vbdy_w(j1:j2) = vbdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2) 932 ENDIF 933 IF(eastern_side) THEN 934 vbdy_e(j1:j2) = vbdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2) 935 ENDIF 936 IF(southern_side) THEN 937 vbdy_s(i1:i2) = vbdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j1) 938 ENDIF 939 IF(northern_side) THEN 940 vbdy_n(i1:i2) = vbdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 941 ENDIF 933 !! clem ghost 934 IF(western_side) vbdy_w(j1:j2) = vbdy_w(j1:j2) + ztcoeff * ptab(i2,j1:j2) 935 IF(eastern_side) vbdy_e(j1:j2) = vbdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2) !clem previously i1 936 IF(southern_side) vbdy_s(i1:i2) = vbdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j2) !clem previously j1 937 IF(northern_side) vbdy_n(i1:i2) = vbdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 942 938 ! 943 939 IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 944 IF(western_side) THEN 945 vbdy_w(j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i1,j1:j2)) & 946 & * vmask(i1,j1:j2,1) 947 ENDIF 948 IF(eastern_side) THEN 949 vbdy_e(j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i1,j1:j2)) & 950 & * vmask(i1,j1:j2,1) 951 ENDIF 952 IF(southern_side) THEN 953 vbdy_s(i1:i2) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j1)) & 954 & * vmask(i1:i2,j1,1) 955 ENDIF 956 IF(northern_side) THEN 957 vbdy_n(i1:i2) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1)) & 958 & * vmask(i1:i2,j1,1) 959 ENDIF 940 IF(western_side) vbdy_w(j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i2,j1:j2)) * vmask(i2,j1:j2,1) 941 IF(eastern_side) vbdy_e(j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i1,j1:j2)) * vmask(i1,j1:j2,1) 942 IF(southern_side) vbdy_s(i1:i2) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j2)) * vmask(i1:i2,j2,1) 943 IF(northern_side) vbdy_n(i1:i2) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1)) * vmask(i1:i2,j1,1) 960 944 ENDIF 961 945 ENDIF … … 991 975 zat = zrhot * ( zt1**2._wp * (-2._wp*zt1 + 3._wp) & 992 976 & - zt0**2._wp * (-2._wp*zt0 + 3._wp) ) 993 ! 994 IF(western_side ) ubdy_w(j1:j2) = zat * ptab(i 1,j1:j2)995 IF(eastern_side ) ubdy_e(j1:j2) = zat * ptab(i1,j1:j2) 996 IF(southern_side) ubdy_s(i1:i2) = zat * ptab(i1:i2,j 1)977 !! clem ghost 978 IF(western_side ) ubdy_w(j1:j2) = zat * ptab(i2,j1:j2) 979 IF(eastern_side ) ubdy_e(j1:j2) = zat * ptab(i1,j1:j2) !clem previously i1 980 IF(southern_side) ubdy_s(i1:i2) = zat * ptab(i1:i2,j2) !clem previously j1 997 981 IF(northern_side) ubdy_n(i1:i2) = zat * ptab(i1:i2,j1) 998 982 ENDIF … … 1030 1014 & - zt0**2._wp * (-2._wp*zt0 + 3._wp) ) 1031 1015 ! 1032 IF(western_side ) vbdy_w(j1:j2) = zat * ptab(i 1,j1:j2)1033 IF(eastern_side ) vbdy_e(j1:j2) = zat * ptab(i1,j1:j2) 1034 IF(southern_side) vbdy_s(i1:i2) = zat * ptab(i1:i2,j 1)1016 IF(western_side ) vbdy_w(j1:j2) = zat * ptab(i2,j1:j2) 1017 IF(eastern_side ) vbdy_e(j1:j2) = zat * ptab(i1,j1:j2) !clem previously i1 1018 IF(southern_side) vbdy_s(i1:i2) = zat * ptab(i1:i2,j2) !clem previously j1 1035 1019 IF(northern_side) vbdy_n(i1:i2) = zat * ptab(i1:i2,j1) 1036 1020 ENDIF … … 1050 1034 INTEGER :: ji, jj, jk 1051 1035 LOGICAL :: western_side, eastern_side, northern_side, southern_side 1052 REAL(wp) :: ztmpmsk1053 1036 !!---------------------------------------------------------------------- 1054 1037 ! … … 1060 1043 southern_side = (nb == 2).AND.(ndir == 1) 1061 1044 northern_side = (nb == 2).AND.(ndir == 2) 1062 1045 ! 1063 1046 DO jk = k1, k2 1064 1047 DO jj = j1, j2 1065 1048 DO ji = i1, i2 1066 ! Get velocity mask at boundary edge points:1067 IF( western_side ) ztmpmsk = umask(ji ,jj ,1)1068 IF( eastern_side ) ztmpmsk = umask(nlci-2,jj ,1)1069 IF( northern_side) ztmpmsk = vmask(ji ,nlcj-2,1)1070 IF( southern_side) ztmpmsk = vmask(ji ,2 ,1)1071 1049 ! 1072 IF( ABS( ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk) ) *ztmpmsk> 1.D-2) THEN1050 IF( ABS( ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk) ) > 1.D-2) THEN 1073 1051 IF (western_side) THEN 1074 1052 WRITE(numout,*) 'ERROR bathymetry merge at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90
r8733 r8738 34 34 !! *** ROUTINE Agrif_Sponge_Tra *** 35 35 !!--------------------------------------------- 36 REAL(wp) :: timecoeff36 REAL(wp) :: zcoef 37 37 !!--------------------------------------------- 38 38 ! 39 39 #if defined SPONGE 40 timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()40 zcoef = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 41 41 42 42 CALL Agrif_Sponge … … 45 45 tabspongedone_tsn = .FALSE. 46 46 47 CALL Agrif_Bc_Variable(tsn_sponge_id,calledweight= timecoeff,procname=interptsn_sponge)47 CALL Agrif_Bc_Variable(tsn_sponge_id,calledweight=zcoef,procname=interptsn_sponge) 48 48 49 49 Agrif_UseSpecialValue = .FALSE. … … 57 57 !! *** ROUTINE Agrif_Sponge_dyn *** 58 58 !!--------------------------------------------- 59 REAL(wp) :: timecoeff59 REAL(wp) :: zcoef 60 60 !!--------------------------------------------- 61 61 62 62 #if defined SPONGE 63 timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()63 zcoef = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 64 64 65 65 Agrif_SpecialValue=0. … … 68 68 tabspongedone_u = .FALSE. 69 69 tabspongedone_v = .FALSE. 70 CALL Agrif_Bc_Variable(un_sponge_id,calledweight= timecoeff,procname=interpun_sponge)70 CALL Agrif_Bc_Variable(un_sponge_id,calledweight=zcoef,procname=interpun_sponge) 71 71 72 72 tabspongedone_u = .FALSE. 73 73 tabspongedone_v = .FALSE. 74 CALL Agrif_Bc_Variable(vn_sponge_id,calledweight= timecoeff,procname=interpvn_sponge)74 CALL Agrif_Bc_Variable(vn_sponge_id,calledweight=zcoef,procname=interpvn_sponge) 75 75 76 76 Agrif_UseSpecialValue = .FALSE. … … 84 84 !! *** ROUTINE Agrif_Sponge *** 85 85 !!--------------------------------------------- 86 INTEGER :: ji,jj,jk 87 INTEGER :: ispongearea, ilci, ilcj 88 LOGICAL :: ll_spdone 89 REAL(wp) :: z1spongearea, zramp 90 REAL(wp), POINTER, DIMENSION(:,:) :: ztabramp 86 REAL(wp), DIMENSION(jpi,jpj) :: ztabramp 87 ! 88 INTEGER :: ji, jj, ind1, ind2 89 INTEGER :: ispongearea 90 REAL(wp) :: z1_spongearea 91 !!--------------------------------------------- 91 92 92 93 #if defined SPONGE || defined SPONGE_TOP 93 ll_spdone=.TRUE.94 94 IF (( .NOT. spongedoneT ).OR.( .NOT. spongedoneU )) THEN 95 ! Define ramp from boundaries towards domain interior 96 ! at T-points 95 ! Define ramp from boundaries towards domain interior at T-points 97 96 ! Store it in ztabramp 98 ll_spdone=.FALSE.99 100 CALL wrk_alloc( jpi, jpj, ztabramp )101 97 102 98 ispongearea = 2 + nn_sponge_len * Agrif_irhox() 103 ilci = nlci - ispongearea 104 ilcj = nlcj - ispongearea 105 z1spongearea = 1._wp / REAL( ispongearea - 2 ) 106 99 z1_spongearea = 1._wp / REAL( ispongearea - 1 ) 100 107 101 ztabramp(:,:) = 0._wp 108 102 103 ! --- West --- ! 109 104 IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN 105 ind1 = 1+nbghostcells 106 ind2 = 1+nbghostcells + (ispongearea-1) 110 107 DO jj = 1, jpj 111 IF ( umask(2,jj,1) == 1._wp ) THEN 112 DO ji = 2, ispongearea 113 ztabramp(ji,jj) = ( ispongearea-ji ) * z1spongearea 114 END DO 115 ENDIF 108 DO ji = ind1, ind2 109 ztabramp(ji,jj) = REAL( ind2 - ji ) * z1_spongearea * umask(ind1,jj,1) 110 END DO 116 111 ENDDO 117 112 ENDIF 118 113 114 ! --- East --- ! 119 115 IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN 116 ind1 = nlci - (1+nbghostcells) - (ispongearea-1) 117 ind2 = nlci - (1+nbghostcells) 120 118 DO jj = 1, jpj 121 IF ( umask(nlci-2,jj,1) == 1._wp ) THEN 122 DO ji = ilci+1,nlci-1 123 zramp = (ji - (ilci+1) ) * z1spongearea 124 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp ) 125 ENDDO 126 ENDIF 119 DO ji = ind1, ind2 120 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ji - ind2 ) * z1_spongearea * umask(ind2-1,jj,1) ) 121 ENDDO 127 122 ENDDO 128 123 ENDIF 129 124 125 ! --- South --- ! 130 126 IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN 131 DO ji = 1, jpi 132 IF ( vmask(ji,2,1) == 1._wp ) THEN 133 DO jj = 2, ispongearea 134 zramp = ( ispongearea-jj ) * z1spongearea 135 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp ) 136 END DO 137 ENDIF 127 ind1 = 1+nbghostcells 128 ind2 = 1+nbghostcells + (ispongearea-1) 129 DO jj = ind1, ind2 130 DO ji = 1, jpi 131 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - jj ) * z1_spongearea * vmask(ji,ind1,1) ) 132 END DO 138 133 ENDDO 139 134 ENDIF 140 135 136 ! --- North --- ! 141 137 IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN 142 DO ji = 1, jpi 143 IF ( vmask(ji,nlcj-2,1) == 1._wp ) THEN 144 DO jj = ilcj+1,nlcj-1 145 zramp = (jj - (ilcj+1) ) * z1spongearea 146 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp ) 147 END DO 148 ENDIF 138 ind1 = nlcj - (1+nbghostcells) - (ispongearea-1) 139 ind2 = nlcj - (1+nbghostcells) 140 DO jj = ind1, ind2 141 DO ji = 1, jpi 142 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( jj - ind2 ) * z1_spongearea * vmask(ji,ind2-1,1) ) 143 END DO 149 144 ENDDO 150 145 ENDIF … … 158 153 DO jj = 2, jpjm1 159 154 DO ji = 2, jpim1 ! vector opt. 160 fsaht_spu(ji,jj) = 0.5_wp * visc_tra * (ztabramp(ji,jj) + ztabramp(ji+1,jj )) 161 fsaht_spv(ji,jj) = 0.5_wp * visc_tra * (ztabramp(ji,jj) + ztabramp(ji ,jj+1)) 162 END DO 163 END DO 164 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 165 159 CALL lbc_lnk( fsaht_spu, 'U', 1. ) ! Lateral boundary conditions 166 160 CALL lbc_lnk( fsaht_spv, 'V', 1. ) 161 167 162 spongedoneT = .TRUE. 168 163 ENDIF … … 179 174 END DO 180 175 END DO 181 182 176 CALL lbc_lnk( fsahm_spt, 'T', 1. ) ! Lateral boundary conditions 183 177 CALL lbc_lnk( fsahm_spf, 'F', 1. ) 178 184 179 spongedoneU = .TRUE. 185 180 ENDIF 186 !187 IF (.NOT.ll_spdone) CALL wrk_dealloc( jpi, jpj, ztabramp )188 181 ! 189 182 #endif … … 205 198 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ztu, ztv 206 199 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::tsbdiff 200 !!--------------------------------------------- 207 201 ! 208 202 IF( before ) THEN … … 327 321 328 322 jmax = j2-1 329 IF ((nbondj == 1).OR.(nbondj == 2)) jmax = MIN(jmax,nlcj- 3)323 IF ((nbondj == 1).OR.(nbondj == 2)) jmax = MIN(jmax,nlcj-nbghostcells-2) ! North 330 324 331 325 DO jj = j1+1, jmax … … 404 398 405 399 imax = i2-1 406 IF ((nbondi == 1).OR.(nbondi == 2)) imax = MIN(imax,nlci- 3)400 IF ((nbondi == 1).OR.(nbondi == 2)) imax = MIN(imax,nlci-nbghostcells-2) ! East 407 401 408 402 DO jj = j1+1, j2 -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90
r8733 r8738 50 50 ! 51 51 INTEGER :: ji, jj, jk, jn ! dummy loop indices 52 INTEGER ::imin, imax, jmin, jmax53 REAL(wp) :: zrhox , zalpha1, zalpha2, zalpha354 REAL(wp) :: zalpha4, zalpha5, zalpha6, zalpha755 LOGICAL :: western_side, eastern_side,northern_side,southern_side56 52 INTEGER :: imin, imax, jmin, jmax 53 REAL(wp) :: zrhox, z1, z2, z3, z4, z5, z6, z7 54 LOGICAL :: western_side, eastern_side,northern_side,southern_side 55 !!----------------------------------------------------------------------- 56 ! 57 57 IF (before) THEN 58 58 ptab(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2) 59 59 ELSE 60 60 ! 61 western_side = (nb == 1).AND.(ndir == 1) 62 eastern_side = (nb == 1).AND.(ndir == 2) 63 southern_side = (nb == 2).AND.(ndir == 1) 64 northern_side = (nb == 2).AND.(ndir == 2) 65 ! 66 zrhox = Agrif_Rhox() 67 ! 68 zalpha1 = ( zrhox - 1. ) * 0.5 69 zalpha2 = 1. - zalpha1 70 ! 71 zalpha3 = ( zrhox - 1. ) / ( zrhox + 1. ) 72 zalpha4 = 1. - zalpha3 73 ! 74 zalpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 75 zalpha7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 76 zalpha5 = 1. - zalpha6 - zalpha7 77 ! 78 imin = i1 79 imax = i2 80 jmin = j1 81 jmax = j2 82 ! 83 ! Remove CORNERS 84 IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3 85 IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2 86 IF((nbondi == -1).OR.(nbondi == 2)) imin = 3 87 IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2 88 ! 89 IF( eastern_side) THEN 90 DO jn = 1, jptra 91 tra(nlci,j1:j2,k1:k2,jn) = zalpha1 * ptab(nlci,j1:j2,k1:k2,jn) + zalpha2 * ptab(nlci-1,j1:j2,k1:k2,jn) 92 DO jk = 1, jpkm1 93 DO jj = jmin,jmax 94 IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 95 tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 96 ELSE 97 tra(nlci-1,jj,jk,jn)=(zalpha4*tra(nlci,jj,jk,jn)+zalpha3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 98 IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 99 tra(nlci-1,jj,jk,jn)=( zalpha6*tra(nlci-2,jj,jk,jn)+zalpha5*tra(nlci,jj,jk,jn) & 100 + zalpha7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 61 IF( nbghostcells > 1 ) THEN ! no smoothing 62 tra(i1:i2,j1:j2,k1:k2,n1:n2) = ptab(i1:i2,j1:j2,k1:k2,n1:n2) 63 ELSE ! smoothing 64 ! 65 western_side = (nb == 1).AND.(ndir == 1) ; eastern_side = (nb == 1).AND.(ndir == 2) 66 southern_side = (nb == 2).AND.(ndir == 1) ; northern_side = (nb == 2).AND.(ndir == 2) 67 ! 68 zrhox = Agrif_Rhox() 69 z1 = ( zrhox - 1. ) * 0.5 70 z3 = ( zrhox - 1. ) / ( zrhox + 1. ) 71 z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 72 z7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 73 ! 74 z2 = 1. - z1 75 z4 = 1. - z3 76 z5 = 1. - z6 - z7 77 ! 78 imin = i1 ; imax = i2 79 jmin = j1 ; jmax = j2 80 ! 81 ! Remove CORNERS 82 IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3 83 IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2 84 IF((nbondi == -1).OR.(nbondi == 2)) imin = 3 85 IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2 86 ! 87 IF( eastern_side) THEN 88 DO jn = 1, jptra 89 tra(nlci,j1:j2,k1:k2,jn) = z1 * ptab(nlci,j1:j2,k1:k2,jn) + z2 * ptab(nlci-1,j1:j2,k1:k2,jn) 90 DO jk = 1, jpkm1 91 DO jj = jmin,jmax 92 IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 93 tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 94 ELSE 95 tra(nlci-1,jj,jk,jn)=(z4*tra(nlci,jj,jk,jn)+z3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 96 IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 97 tra(nlci-1,jj,jk,jn)=( z6*tra(nlci-2,jj,jk,jn)+z5*tra(nlci,jj,jk,jn) & 98 + z7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 99 ENDIF 101 100 ENDIF 102 ENDIF 101 END DO 102 END DO 103 ENDDO 104 ENDIF 105 ! 106 IF( northern_side ) THEN 107 DO jn = 1, jptra 108 tra(i1:i2,nlcj,k1:k2,jn) = z1 * ptab(i1:i2,nlcj,k1:k2,jn) + z2 * ptab(i1:i2,nlcj-1,k1:k2,jn) 109 DO jk = 1, jpkm1 110 DO ji = imin,imax 111 IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN 112 tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 113 ELSE 114 tra(ji,nlcj-1,jk,jn)=(z4*tra(ji,nlcj,jk,jn)+z3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk) 115 IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN 116 tra(ji,nlcj-1,jk,jn)=( z6*tra(ji,nlcj-2,jk,jn)+z5*tra(ji,nlcj,jk,jn) & 117 + z7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 118 ENDIF 119 ENDIF 120 END DO 121 END DO 122 ENDDO 123 ENDIF 124 ! 125 IF( western_side) THEN 126 DO jn = 1, jptra 127 tra(1,j1:j2,k1:k2,jn) = z1 * ptab(1,j1:j2,k1:k2,jn) + z2 * ptab(2,j1:j2,k1:k2,jn) 128 DO jk = 1, jpkm1 129 DO jj = jmin,jmax 130 IF( umask(2,jj,jk) == 0.e0 ) THEN 131 tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk) 132 ELSE 133 tra(2,jj,jk,jn)=(z4*tra(1,jj,jk,jn)+z3*tra(3,jj,jk,jn))*tmask(2,jj,jk) 134 IF( un(2,jj,jk) < 0.e0 ) THEN 135 tra(2,jj,jk,jn)=(z6*tra(3,jj,jk,jn)+z5*tra(1,jj,jk,jn)+z7*tra(4,jj,jk,jn))*tmask(2,jj,jk) 136 ENDIF 137 ENDIF 138 END DO 103 139 END DO 104 140 END DO 105 ENDDO 141 ENDIF 142 ! 143 IF( southern_side ) THEN 144 DO jn = 1, jptra 145 tra(i1:i2,1,k1:k2,jn) = z1 * ptab(i1:i2,1,k1:k2,jn) + z2 * ptab(i1:i2,2,k1:k2,jn) 146 DO jk=1,jpk 147 DO ji=imin,imax 148 IF( vmask(ji,2,jk) == 0.e0 ) THEN 149 tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk) 150 ELSE 151 tra(ji,2,jk,jn)=(z4*tra(ji,1,jk,jn)+z3*tra(ji,3,jk,jn))*tmask(ji,2,jk) 152 IF( vn(ji,2,jk) < 0.e0 ) THEN 153 tra(ji,2,jk,jn)=(z6*tra(ji,3,jk,jn)+z5*tra(ji,1,jk,jn)+z7*tra(ji,4,jk,jn))*tmask(ji,2,jk) 154 ENDIF 155 ENDIF 156 END DO 157 END DO 158 ENDDO 159 ENDIF 160 ! 161 ! Treatment of corners 162 IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) tra(nlci-1,2,:,:) = ptab(nlci-1,2,:,:) ! East south 163 IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) tra(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:) ! East north 164 IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) tra(2,2,:,:) = ptab(2,2,:,:) ! West south 165 IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) tra(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:) ! West north 166 ! 106 167 ENDIF 107 !108 IF( northern_side ) THEN109 DO jn = 1, jptra110 tra(i1:i2,nlcj,k1:k2,jn) = zalpha1 * ptab(i1:i2,nlcj,k1:k2,jn) + zalpha2 * ptab(i1:i2,nlcj-1,k1:k2,jn)111 DO jk = 1, jpkm1112 DO ji = imin,imax113 IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN114 tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)115 ELSE116 tra(ji,nlcj-1,jk,jn)=(zalpha4*tra(ji,nlcj,jk,jn)+zalpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)117 IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN118 tra(ji,nlcj-1,jk,jn)=( zalpha6*tra(ji,nlcj-2,jk,jn)+zalpha5*tra(ji,nlcj,jk,jn) &119 + zalpha7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)120 ENDIF121 ENDIF122 END DO123 END DO124 ENDDO125 ENDIF126 !127 IF( western_side) THEN128 DO jn = 1, jptra129 tra(1,j1:j2,k1:k2,jn) = zalpha1 * ptab(1,j1:j2,k1:k2,jn) + zalpha2 * ptab(2,j1:j2,k1:k2,jn)130 DO jk = 1, jpkm1131 DO jj = jmin,jmax132 IF( umask(2,jj,jk) == 0.e0 ) THEN133 tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk)134 ELSE135 tra(2,jj,jk,jn)=(zalpha4*tra(1,jj,jk,jn)+zalpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk)136 IF( un(2,jj,jk) < 0.e0 ) THEN137 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)138 ENDIF139 ENDIF140 END DO141 END DO142 END DO143 ENDIF144 !145 IF( southern_side ) THEN146 DO jn = 1, jptra147 tra(i1:i2,1,k1:k2,jn) = zalpha1 * ptab(i1:i2,1,k1:k2,jn) + zalpha2 * ptab(i1:i2,2,k1:k2,jn)148 DO jk=1,jpk149 DO ji=imin,imax150 IF( vmask(ji,2,jk) == 0.e0 ) THEN151 tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk)152 ELSE153 tra(ji,2,jk,jn)=(zalpha4*tra(ji,1,jk,jn)+zalpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk)154 IF( vn(ji,2,jk) < 0.e0 ) THEN155 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)156 ENDIF157 ENDIF158 END DO159 END DO160 ENDDO161 ENDIF162 !163 ! Treatment of corners164 !165 ! East south166 IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN167 tra(nlci-1,2,:,:) = ptab(nlci-1,2,:,:)168 ENDIF169 ! East north170 IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN171 tra(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:)172 ENDIF173 ! West south174 IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN175 tra(2,2,:,:) = ptab(2,2,:,:)176 ENDIF177 ! West north178 IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN179 tra(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:)180 ENDIF181 !182 168 ENDIF 183 169 ! -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
r8733 r8738 127 127 !! 128 128 IMPLICIT NONE 129 ! 130 INTEGER :: ind1, ind2, ind3 129 131 !!---------------------------------------------------------------------- 130 132 131 133 ! 1. Declaration of the type of variable which have to be interpolated 132 134 !--------------------------------------------------------------------- 133 CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id) 134 CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id) 135 !!clem ghost 136 ind1 = nbghostcells 137 ind2 = 1 + nbghostcells 138 ind3 = 2 + nbghostcells 139 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id) 140 CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id) 141 !!clem ghost 135 142 136 143 ! 2. Type of interpolation … … 141 148 ! 3. Location of interpolation 142 149 !----------------------------- 143 CALL Agrif_Set_bc(e1u_id,(/0,0/)) 144 CALL Agrif_Set_bc(e2v_id,(/0,0/)) 150 !!clem ghost (previously set to /0,0/) 151 CALL Agrif_Set_bc(e1u_id,(/0,ind1-1/)) 152 CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/)) 153 !!clem ghost 145 154 146 155 ! 5. Update type … … 337 346 !!---------------------------------------------------------------------- 338 347 USE agrif_util 339 USE par_oce ! ONLY : jpts 348 USE par_oce ! ONLY : jpts and ghostcells 340 349 USE oce 341 350 USE agrif_oce 342 351 !! 343 352 IMPLICIT NONE 353 ! 354 INTEGER :: ind1, ind2, ind3 344 355 !!---------------------------------------------------------------------- 345 356 346 357 ! 1. Declaration of the type of variable which have to be interpolated 347 358 !--------------------------------------------------------------------- 348 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) 349 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) 350 351 CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_interp_id) 352 CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_interp_id) 353 CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_update_id) 354 CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_update_id) 355 CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_sponge_id) 356 CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_sponge_id) 357 358 CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id) 359 CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id) 360 CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id) 361 362 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) 363 364 CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id) 365 CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id) 366 CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id) 367 CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id) 368 CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id) 369 CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id) 370 371 CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id) 359 !!clem ghost 360 ind1 = nbghostcells 361 ind2 = 1 + nbghostcells 362 ind3 = 2 + nbghostcells 363 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id) 364 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id) 365 366 CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_interp_id) 367 CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_interp_id) 368 CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_update_id) 369 CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_update_id) 370 CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_sponge_id) 371 CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_sponge_id) 372 373 CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id) 374 CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id) 375 CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id) 376 377 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,3/),scales_t_id) 378 379 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id) 380 CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id) 381 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id) 382 CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id) 383 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id) 384 CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id) 385 386 CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id) 372 387 373 388 # if defined key_zdftke 374 CALL agrif_declare_variable((/2,2,0/),(/ 3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id)375 CALL agrif_declare_variable((/2,2,0/),(/ 3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id)376 CALL agrif_declare_variable((/2,2,0/),(/ 3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avm_id)389 CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id) 390 CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id) 391 CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avm_id) 377 392 # endif 393 !!clem ghost 378 394 379 395 ! 2. Type of interpolation … … 407 423 ! 3. Location of interpolation 408 424 !----------------------------- 409 CALL Agrif_Set_bc(tsn_id,(/0,1/)) 410 CALL Agrif_Set_bc(un_interp_id,(/0,1/)) 411 CALL Agrif_Set_bc(vn_interp_id,(/0,1/)) 412 413 ! CALL Agrif_Set_bc(tsn_sponge_id,(/-3*Agrif_irhox(),0/)) 414 ! CALL Agrif_Set_bc(un_sponge_id,(/-2*Agrif_irhox()-1,0/)) 415 ! CALL Agrif_Set_bc(vn_sponge_id,(/-2*Agrif_irhox()-1,0/)) 416 CALL Agrif_Set_bc(tsn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 425 !!clem ghost 426 CALL Agrif_Set_bc(tsn_id,(/0,ind1/)) 427 CALL Agrif_Set_bc(un_interp_id,(/0,ind1/)) 428 CALL Agrif_Set_bc(vn_interp_id,(/0,ind1/)) 429 430 ! clem: previously set to /-,0/ 431 CALL Agrif_Set_bc(tsn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/)) ! if west and rhox=3 and sponge=2 and ghost=1: columns 2 to 9 417 432 CALL Agrif_Set_bc(un_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 418 433 CALL Agrif_Set_bc(vn_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 419 434 420 CALL Agrif_Set_bc(sshn_id,(/0,0/)) 421 CALL Agrif_Set_bc(unb_id ,(/0,0/)) 422 CALL Agrif_Set_bc(vnb_id ,(/0,0/)) 423 CALL Agrif_Set_bc(ub2b_interp_id,(/0,0/)) 424 CALL Agrif_Set_bc(vb2b_interp_id,(/0,0/)) 425 426 CALL Agrif_Set_bc(e3t_id,(/-2*Agrif_irhox()-1,0/)) ! if west and rhox=3: column 2 to 9 427 CALL Agrif_Set_bc(umsk_id,(/0,0/)) 428 CALL Agrif_Set_bc(vmsk_id,(/0,0/)) 429 435 CALL Agrif_Set_bc(sshn_id,(/0,ind1-1/)) 436 CALL Agrif_Set_bc(unb_id ,(/0,ind1-1/)) 437 CALL Agrif_Set_bc(vnb_id ,(/0,ind1-1/)) 438 CALL Agrif_Set_bc(ub2b_interp_id,(/0,ind1-1/)) 439 CALL Agrif_Set_bc(vb2b_interp_id,(/0,ind1-1/)) 440 441 CALL Agrif_Set_bc(e3t_id,(/-2*Agrif_irhox()-1,ind1-1/)) ! if west and rhox=3 and ghost=1: column 2 to 9 442 CALL Agrif_Set_bc(umsk_id,(/0,ind1-1/)) 443 CALL Agrif_Set_bc(vmsk_id,(/0,ind1-1/)) 444 445 ! clem: previously set to /0,1/ 430 446 # if defined key_zdftke 431 CALL Agrif_Set_bc(avm_id ,(/0, 1/))447 CALL Agrif_Set_bc(avm_id ,(/0,ind1/)) 432 448 # endif 449 !!clem ghost 433 450 434 451 ! 5. Update type … … 463 480 ! 464 481 END SUBROUTINE agrif_declare_var 465 466 # if defined key_lim2467 SUBROUTINE Agrif_InitValues_cont_lim2468 !!----------------------------------------------------------------------469 !! *** ROUTINE Agrif_InitValues_cont_lim2 ***470 !!471 !! ** Purpose :: Initialisation of variables to be interpolated for LIM2472 !!----------------------------------------------------------------------473 USE Agrif_Util474 USE ice_2475 USE agrif_ice476 USE in_out_manager477 USE agrif_lim2_update478 USE agrif_lim2_interp479 USE lib_mpp480 !!481 IMPLICIT NONE482 !!----------------------------------------------------------------------483 484 ! 1. Declaration of the type of variable which have to be interpolated485 !---------------------------------------------------------------------486 CALL agrif_declare_var_lim2487 488 ! 2. First interpolations of potentially non zero fields489 !-------------------------------------------------------490 Agrif_SpecialValue=-9999.491 Agrif_UseSpecialValue = .TRUE.492 ! Call Agrif_Bc_variable(zadv ,adv_ice_id ,calledweight=1.,procname=interp_adv_ice )493 ! Call Agrif_Bc_variable(zvel ,u_ice_id ,calledweight=1.,procname=interp_u_ice )494 ! Call Agrif_Bc_variable(zvel ,v_ice_id ,calledweight=1.,procname=interp_v_ice )495 Agrif_SpecialValue=0.496 Agrif_UseSpecialValue = .FALSE.497 498 ! 3. Some controls499 !-----------------500 501 # if ! defined key_lim2_vp502 lim_nbstep = 1.503 CALL agrif_rhg_lim2_load504 CALL agrif_trp_lim2_load505 lim_nbstep = 0.506 # endif507 !RB mandatory but why ???508 ! IF( nbclineupdate /= nn_fsbc .AND. nn_ice == 2 )THEN509 ! CALL ctl_warn ('With ice model on child grid, nbclineupdate is set to nn_fsbc')510 ! nbclineupdate = nn_fsbc511 ! ENDIF512 CALL Agrif_Update_lim2(0)513 !514 END SUBROUTINE Agrif_InitValues_cont_lim2515 516 517 SUBROUTINE agrif_declare_var_lim2518 !!----------------------------------------------------------------------519 !! *** ROUTINE agrif_declare_var_lim2 ***520 !!521 !! ** Purpose :: Declaration of variables to be interpolated for LIM2522 !!----------------------------------------------------------------------523 USE agrif_util524 USE ice_2525 !!526 IMPLICIT NONE527 !!----------------------------------------------------------------------528 529 ! 1. Declaration of the type of variable which have to be interpolated530 !---------------------------------------------------------------------531 CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj, 7/),adv_ice_id )532 # if defined key_lim2_vp533 CALL agrif_declare_variable((/1,1/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),u_ice_id)534 CALL agrif_declare_variable((/1,1/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),v_ice_id)535 # else536 CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),u_ice_id)537 CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),v_ice_id)538 # endif539 540 ! 2. Type of interpolation541 !-------------------------542 CALL Agrif_Set_bcinterp(adv_ice_id ,interp=AGRIF_linear)543 CALL Agrif_Set_bcinterp(u_ice_id,interp1=Agrif_linear,interp2=AGRIF_ppm)544 CALL Agrif_Set_bcinterp(v_ice_id,interp1=AGRIF_ppm,interp2=Agrif_linear)545 546 ! 3. Location of interpolation547 !-----------------------------548 CALL Agrif_Set_bc(adv_ice_id ,(/0,1/))549 CALL Agrif_Set_bc(u_ice_id,(/0,1/))550 CALL Agrif_Set_bc(v_ice_id,(/0,1/))551 552 ! 5. Update type553 !---------------554 CALL Agrif_Set_Updatetype(adv_ice_id , update = AGRIF_Update_Average)555 CALL Agrif_Set_Updatetype(u_ice_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)556 CALL Agrif_Set_Updatetype(v_ice_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)557 !558 END SUBROUTINE agrif_declare_var_lim2559 # endif560 482 561 483 #if defined key_lim3 … … 623 545 USE Agrif_Util 624 546 USE ice 625 626 IMPLICIT NONE 547 USE par_oce, ONLY : nbghostcells 548 ! 549 IMPLICIT NONE 550 ! 551 INTEGER :: ind1, ind2, ind3 627 552 !!---------------------------------------------------------------------- 628 553 ! … … 634 559 ! 2,2 = two ghost lines 635 560 !------------------------------------------------------------------------------------- 636 CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(5+nlay_s+nlay_i)/),tra_ice_id ) 637 CALL agrif_declare_variable((/1,2/) ,(/2,3/),(/'x','y'/) ,(/1,1/) ,(/nlci,nlcj/) ,u_ice_id ) 638 CALL agrif_declare_variable((/2,1/) ,(/3,2/),(/'x','y'/) ,(/1,1/) ,(/nlci,nlcj/) ,v_ice_id ) 561 !!clem ghost 562 ind1 = nbghostcells 563 ind2 = 1 + nbghostcells 564 ind3 = 2 + nbghostcells 565 CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(5+nlay_s+nlay_i)/),tra_ice_id ) 566 CALL agrif_declare_variable((/1,2/) ,(/ind2,ind3/) ,(/'x','y'/) ,(/1,1/) ,(/nlci,nlcj/) ,u_ice_id ) 567 CALL agrif_declare_variable((/2,1/) ,(/ind3,ind2/) ,(/'x','y'/) ,(/1,1/) ,(/nlci,nlcj/) ,v_ice_id ) 568 !!clem ghost 639 569 640 570 ! 2. Set interpolations (normal & tangent to the grid cell for velocities) … … 646 576 ! 3. Set location of interpolations 647 577 !---------------------------------- 648 CALL Agrif_Set_bc(tra_ice_id,(/0,1/)) 649 CALL Agrif_Set_bc(u_ice_id ,(/0,1/)) 650 CALL Agrif_Set_bc(v_ice_id ,(/0,1/)) 578 !!clem ghost 579 CALL Agrif_Set_bc(tra_ice_id,(/0,ind1/)) 580 CALL Agrif_Set_bc(u_ice_id ,(/0,ind1/)) 581 CALL Agrif_Set_bc(v_ice_id ,(/0,ind1/)) 582 !!clem ghost 651 583 652 584 ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities) … … 777 709 !! 778 710 IMPLICIT NONE 711 ! 712 INTEGER :: ind1, ind2, ind3 779 713 !!---------------------------------------------------------------------- 780 714 781 715 ! 1. Declaration of the type of variable which have to be interpolated 782 716 !--------------------------------------------------------------------- 783 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) 784 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) 717 !!clem ghost 718 ind1 = nbghostcells 719 ind2 = 1 + nbghostcells 720 ind3 = 2 + nbghostcells 721 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_id) 722 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_sponge_id) 785 723 786 724 ! 2. Type of interpolation … … 791 729 ! 3. Location of interpolation 792 730 !----------------------------- 793 CALL Agrif_Set_bc(trn_id,(/0,1/)) 794 ! CALL Agrif_Set_bc(trn_sponge_id,(/-3*Agrif_irhox(),0/)) 731 !!clem ghost 732 CALL Agrif_Set_bc(trn_id,(/0,ind1/)) 733 !clem: previously set to /-,0/ 795 734 CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 796 735 … … 868 807 ! 869 808 IF( agrif_oce_alloc() > 0 ) CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed') 870 # if defined key_lim2871 IF( agrif_ice_alloc() > 0 ) CALL ctl_stop('agrif agrif_ice_alloc: allocation of arrays failed') ! only for LIM2 (not LIM3)872 # endif873 809 ! 874 810 END SUBROUTINE agrif_nemo_init -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90
r8733 r8738 38 38 USE asmpar ! Parameters for the assmilation interface 39 39 USE zdfmxl ! mixed layer depth 40 #if defined key_lim241 USE ice_242 #endif43 40 #if defined key_lim3 44 41 USE ice … … 148 145 CALL iom_rstput( kt, nitdin_r, inum, 'sn' , tsn(:,:,:,jp_sal) ) 149 146 CALL iom_rstput( kt, nitdin_r, inum, 'sshn' , sshn ) 150 #if defined key_lim 2 || defined key_lim3151 IF( nn_ice == 2 .OR. nn_ice == 3) THEN152 IF( ALLOCATED( frld) ) THEN153 CALL iom_rstput( kt, nitdin_r, inum, 'iceconc', 1._wp - frld(:,:) )147 #if defined key_lim3 148 IF( nn_ice == 2 ) THEN 149 IF( ALLOCATED(at_i) ) THEN 150 CALL iom_rstput( kt, nitdin_r, inum, 'iceconc', at_i(:,:) ) 154 151 ELSE 155 CALL ctl_warn('Ice concentration not written to background as ice variable frldnot allocated on this timestep')152 CALL ctl_warn('Ice concentration not written to background as ice variable at_i not allocated on this timestep') 156 153 ENDIF 157 154 ENDIF -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90
r8733 r8738 35 35 USE in_out_manager ! I/O manager 36 36 USE lib_mpp ! MPP library 37 #if defined key_lim 238 USE ice _2 ! LIM237 #if defined key_lim3 38 USE ice, ONLY: hm_i, at_i, at_i_b 39 39 #endif 40 40 USE sbc_oce ! Surface boundary condition variables. … … 809 809 INTEGER :: it 810 810 REAL(wp) :: zincwgt ! IAU weight for current time step 811 #if defined key_lim 2811 #if defined key_lim3 812 812 REAL(wp), DIMENSION(jpi,jpj) :: zofrld, zohicif, zseaicendg, zhicifinc ! LIM 813 813 REAL(wp) :: zhicifmin = 0.5_wp ! ice minimum depth in metres … … 831 831 ENDIF 832 832 ! 833 ! Sea-ice : LIM-3 case (to add) 834 ! 835 #if defined key_lim2 836 ! Sea-ice : LIM-2 case 837 zofrld (:,:) = frld(:,:) 838 zohicif(:,:) = hicif(:,:) 839 ! 840 frld = MIN( MAX( frld (:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp) 841 pfrld = MIN( MAX( pfrld(:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp) 842 fr_i(:,:) = 1.0_wp - frld(:,:) ! adjust ice fraction 843 ! 844 zseaicendg(:,:) = zofrld(:,:) - frld(:,:) ! find out actual sea ice nudge applied 833 ! Sea-ice : LIM-3 case 834 ! 835 #if defined key_lim3 836 zofrld (:,:) = 1._wp - at_i(:,:) 837 zohicif(:,:) = hm_i(:,:) 838 ! 839 at_i (:,:) = 1. - MIN( MAX( 1.-at_i (:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp) 840 at_i_b(:,:) = 1. - MIN( MAX( 1.-at_i_b(:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp) 841 fr_i(:,:) = at_i(:,:) ! adjust ice fraction 842 ! 843 zseaicendg(:,:) = zofrld(:,:) - (1. - at_i(:,:)) ! find out actual sea ice nudge applied 845 844 ! 846 845 ! Nudge sea ice depth to bring it up to a required minimum depth 847 WHERE( zseaicendg(:,:) > 0.0_wp .AND. h icif(:,:) < zhicifmin )848 zhicifinc(:,:) = (zhicifmin - h icif(:,:)) * zincwgt846 WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i(:,:) < zhicifmin ) 847 zhicifinc(:,:) = (zhicifmin - hm_i(:,:)) * zincwgt 849 848 ELSEWHERE 850 849 zhicifinc(:,:) = 0.0_wp … … 852 851 ! 853 852 ! nudge ice depth 854 hicif (:,:) = hicif (:,:) + zhicifinc(:,:) 855 phicif(:,:) = phicif(:,:) + zhicifinc(:,:) 853 hm_i (:,:) = hm_i (:,:) + zhicifinc(:,:) 856 854 ! 857 855 ! seaice salinity balancing (to add) … … 882 880 neuler = 0 ! Force Euler forward step 883 881 ! 884 ! Sea-ice : LIM-3 case (to add) 885 ! 886 #if defined key_lim2 887 ! Sea-ice : LIM-2 case. 888 zofrld(:,:)=frld(:,:) 889 zohicif(:,:)=hicif(:,:) 882 ! Sea-ice : LIM-3 case 883 ! 884 #if defined key_lim3 885 zofrld (:,:) = 1._wp - at_i(:,:) 886 zohicif(:,:) = hm_i(:,:) 890 887 ! 891 888 ! Initialize the now fields the background + increment 892 frld (:,:) = MIN( MAX( frld(:,:) - seaice_bkginc(:,:), 0.0_wp), 1.0_wp) 893 pfrld(:,:) = frld(:,:) 894 fr_i (:,:) = 1.0_wp - frld(:,:) ! adjust ice fraction 895 zseaicendg(:,:) = zofrld(:,:) - frld(:,:) ! find out actual sea ice nudge applied 889 at_i(:,:) = 1. - MIN( MAX( 1.-at_i(:,:) - seaice_bkginc(:,:), 0.0_wp), 1.0_wp) 890 at_i_b(:,:) = at_i(:,:) 891 fr_i(:,:) = at_i(:,:) ! adjust ice fraction 892 ! 893 zseaicendg(:,:) = zofrld(:,:) - (1. - at_i(:,:)) ! find out actual sea ice nudge applied 896 894 ! 897 895 ! Nudge sea ice depth to bring it up to a required minimum depth 898 WHERE( zseaicendg(:,:) > 0.0_wp .AND. h icif(:,:) < zhicifmin )899 zhicifinc(:,:) = (zhicifmin - h icif(:,:)) * zincwgt896 WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i(:,:) < zhicifmin ) 897 zhicifinc(:,:) = (zhicifmin - hm_i(:,:)) * zincwgt 900 898 ELSEWHERE 901 zhicifinc(:,:) = 0. _wp899 zhicifinc(:,:) = 0.0_wp 902 900 END WHERE 903 901 ! 904 902 ! nudge ice depth 905 hicif (:,:) = hicif (:,:) + zhicifinc(:,:) 906 phicif(:,:) = phicif(:,:) 903 hm_i (:,:) = hm_i (:,:) + zhicifinc(:,:) 907 904 ! 908 905 ! seaice salinity balancing (to add) … … 926 923 ENDIF 927 924 928 !#if defined defined key_lim 2|| defined key_cice925 !#if defined defined key_lim3 || defined key_cice 929 926 ! 930 927 ! IF (ln_seaicebal ) THEN -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90
r8733 r8738 55 55 REAL(wp), POINTER, DIMENSION(:,:) :: tem 56 56 REAL(wp), POINTER, DIMENSION(:,:) :: sal 57 #if defined key_lim2 58 LOGICAL :: ll_frld 59 LOGICAL :: ll_hicif 60 LOGICAL :: ll_hsnif 61 REAL(wp), POINTER, DIMENSION(:) :: frld 62 REAL(wp), POINTER, DIMENSION(:) :: hicif 63 REAL(wp), POINTER, DIMENSION(:) :: hsnif 64 #elif defined key_lim3 57 #if defined key_lim3 65 58 LOGICAL :: ll_a_i 66 LOGICAL :: ll_h t_i67 LOGICAL :: ll_h t_s59 LOGICAL :: ll_h_i 60 LOGICAL :: ll_h_s 68 61 REAL(wp), POINTER, DIMENSION(:,:) :: a_i !: now ice leads fraction climatology 69 REAL(wp), POINTER, DIMENSION(:,:) :: h t_i!: Now ice thickness climatology70 REAL(wp), POINTER, DIMENSION(:,:) :: h t_s!: now snow thickness62 REAL(wp), POINTER, DIMENSION(:,:) :: h_i !: Now ice thickness climatology 63 REAL(wp), POINTER, DIMENSION(:,:) :: h_s !: now snow thickness 71 64 #endif 72 65 #if defined key_top -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90
r8733 r8738 25 25 USE iom ! IOM library 26 26 USE in_out_manager ! I/O logical units 27 #if defined key_lim2 28 USE ice_2 29 #elif defined key_lim3 27 #if defined key_lim3 30 28 USE ice 31 USE limvar ! redistribute ice input into categories29 USE icevar ! redistribute ice input into categories 32 30 #endif 33 31 USE sbcapr … … 50 48 51 49 #if defined key_lim3 52 LOGICAL :: ll_bdylim3 ! determine whether ice input is lim2 (F) or lim3(T) type50 LOGICAL :: ll_bdylim3 ! determine whether ice input is 1cat (F) or Xcat (T) type 53 51 INTEGER :: jfld_hti, jfld_hts, jfld_ai ! indices of ice thickness, snow thickness and concentration in bf structure 54 52 #endif … … 176 174 ENDIF 177 175 178 #if defined key_lim2 179 IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN 180 ilen1(:) = nblen(:) 181 IF( dta%ll_frld ) THEN 182 igrd = 1 183 DO ib = 1, ilen1(igrd) 184 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 185 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 186 dta_bdy(ib_bdy)%frld(ib) = frld(ii,ij) * tmask(ii,ij,1) 187 END DO 188 END IF 189 IF( dta%ll_hicif ) THEN 190 igrd = 1 191 DO ib = 1, ilen1(igrd) 192 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 193 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 194 dta_bdy(ib_bdy)%hicif(ib) = hicif(ii,ij) * tmask(ii,ij,1) 195 END DO 196 END IF 197 IF( dta%ll_hsnif ) THEN 198 igrd = 1 199 DO ib = 1, ilen1(igrd) 200 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 201 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 202 dta_bdy(ib_bdy)%hsnif(ib) = hsnif(ii,ij) * tmask(ii,ij,1) 203 END DO 204 END IF 205 ENDIF 206 #elif defined key_lim3 176 #if defined key_lim3 207 177 IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN 208 178 ilen1(:) = nblen(:) … … 217 187 END DO 218 188 ENDIF 219 IF( dta%ll_h t_i ) THEN189 IF( dta%ll_h_i ) THEN 220 190 igrd = 1 221 191 DO jl = 1, jpl … … 223 193 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 224 194 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 225 dta_bdy(ib_bdy)%h t_i (ib,jl) = ht_i(ii,ij,jl) * tmask(ii,ij,1)195 dta_bdy(ib_bdy)%h_i (ib,jl) = h_i(ii,ij,jl) * tmask(ii,ij,1) 226 196 END DO 227 197 END DO 228 198 ENDIF 229 IF( dta%ll_h t_s ) THEN199 IF( dta%ll_h_s ) THEN 230 200 igrd = 1 231 201 DO jl = 1, jpl … … 233 203 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 234 204 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 235 dta_bdy(ib_bdy)%h t_s (ib,jl) = ht_s(ii,ij,jl) * tmask(ii,ij,1)205 dta_bdy(ib_bdy)%h_s (ib,jl) = h_s(ii,ij,jl) * tmask(ii,ij,1) 236 206 END DO 237 207 END DO … … 373 343 ENDIF 374 344 #if defined key_lim3 375 IF( .NOT. ll_bdylim3 .AND. cn_ice_lim(ib_bdy) /= 'none' .AND. nn_ice_lim_dta(ib_bdy) == 1 ) THEN ! bdy ice input (case input is lim2 type)376 CALL lim_var_itd ( bf(jfld_hti)%fnow(:,1,1), bf(jfld_hts)%fnow(:,1,1), bf(jfld_ai)%fnow(:,1,1), &377 & dta_bdy(ib_bdy)%h t_i, dta_bdy(ib_bdy)%ht_s, dta_bdy(ib_bdy)%a_i )345 IF( .NOT. ll_bdylim3 .AND. cn_ice_lim(ib_bdy) /= 'none' .AND. nn_ice_lim_dta(ib_bdy) == 1 ) THEN ! bdy ice input (case input is 1cat) 346 CALL ice_var_itd ( bf(jfld_hti)%fnow(:,1,1), bf(jfld_hts)%fnow(:,1,1), bf(jfld_ai)%fnow(:,1,1), & 347 & dta_bdy(ib_bdy)%h_i, dta_bdy(ib_bdy)%h_s, dta_bdy(ib_bdy)%a_i ) 378 348 ENDIF 379 349 #endif … … 449 419 TYPE(FLD_N) :: bn_tem, bn_sal, bn_u3d, bn_v3d ! 450 420 TYPE(FLD_N) :: bn_ssh, bn_u2d, bn_v2d ! informations about the fields to be read 451 #if defined key_lim2 452 TYPE(FLD_N) :: bn_frld, bn_hicif, bn_hsnif ! 453 #elif defined key_lim3 454 TYPE(FLD_N) :: bn_a_i, bn_ht_i, bn_ht_s 421 #if defined key_lim3 422 TYPE(FLD_N) :: bn_a_i, bn_h_i, bn_h_s 455 423 #endif 456 424 NAMELIST/nambdy_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d 457 #if defined key_lim2 458 NAMELIST/nambdy_dta/ bn_frld, bn_hicif, bn_hsnif 459 #elif defined key_lim3 460 NAMELIST/nambdy_dta/ bn_a_i, bn_ht_i, bn_ht_s 425 #if defined key_lim3 426 NAMELIST/nambdy_dta/ bn_a_i, bn_h_i, bn_h_s 461 427 #endif 462 428 NAMELIST/nambdy_dta/ ln_full_vel, nb_jpk_bdy … … 475 441 ,nn_dyn3d_dta(ib_bdy) & 476 442 ,nn_tra_dta(ib_bdy) & 477 #if ( defined key_lim2 || defined key_lim3 )443 #if defined key_lim3 478 444 ,nn_ice_lim_dta(ib_bdy) & 479 445 #endif … … 496 462 nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2 497 463 ENDIF 498 #if ( defined key_lim2 || defined key_lim3 )464 #if defined key_lim3 499 465 IF( cn_ice_lim(ib_bdy) /= 'none' .and. nn_ice_lim_dta(ib_bdy) == 1 ) THEN 500 466 nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3 … … 637 603 ENDIF 638 604 639 #if defined key_lim 2605 #if defined key_lim3 640 606 ! sea ice 641 607 IF( nn_ice_lim_dta(ib_bdy) == 1 ) THEN 642 643 IF( dta%ll_frld ) THEN 644 jfld = jfld + 1 645 blf_i(jfld) = bn_frld 646 ibdy(jfld) = ib_bdy 647 igrid(jfld) = 1 648 ilen1(jfld) = nblen(igrid(jfld)) 649 ilen3(jfld) = 1 650 ENDIF 651 652 IF( dta%ll_hicif ) THEN 653 jfld = jfld + 1 654 blf_i(jfld) = bn_hicif 655 ibdy(jfld) = ib_bdy 656 igrid(jfld) = 1 657 ilen1(jfld) = nblen(igrid(jfld)) 658 ilen3(jfld) = 1 659 ENDIF 660 661 IF( dta%ll_hsnif ) THEN 662 jfld = jfld + 1 663 blf_i(jfld) = bn_hsnif 664 ibdy(jfld) = ib_bdy 665 igrid(jfld) = 1 666 ilen1(jfld) = nblen(igrid(jfld)) 667 ilen3(jfld) = 1 668 ENDIF 669 670 ENDIF 671 #elif defined key_lim3 672 ! sea ice 673 IF( nn_ice_lim_dta(ib_bdy) == 1 ) THEN 674 ! Test for types of ice input (lim2 or lim3) 608 ! Test for types of ice input (1cat or Xcat) 675 609 ! Build file name to find dimensions 676 610 clname=TRIM( cn_dir )//TRIM(bn_a_i%clname) … … 689 623 690 624 IF ( zndims == 4 ) THEN 691 ll_bdylim3 = .TRUE. ! lim3input625 ll_bdylim3 = .TRUE. ! Xcat input 692 626 ELSE 693 ll_bdylim3 = .FALSE. ! lim2input627 ll_bdylim3 = .FALSE. ! 1cat input 694 628 ENDIF 695 629 ! End test … … 704 638 ENDIF 705 639 706 IF( dta%ll_h t_i ) THEN707 jfld = jfld + 1 708 blf_i(jfld) = bn_h t_i640 IF( dta%ll_h_i ) THEN 641 jfld = jfld + 1 642 blf_i(jfld) = bn_h_i 709 643 ibdy(jfld) = ib_bdy 710 644 igrid(jfld) = 1 … … 713 647 ENDIF 714 648 715 IF( dta%ll_h t_s ) THEN716 jfld = jfld + 1 717 blf_i(jfld) = bn_h t_s649 IF( dta%ll_h_s ) THEN 650 jfld = jfld + 1 651 blf_i(jfld) = bn_h_s 718 652 ibdy(jfld) = ib_bdy 719 653 igrid(jfld) = 1 … … 848 782 ENDIF 849 783 850 #if defined key_lim 2784 #if defined key_lim3 851 785 IF (cn_ice_lim(ib_bdy) /= 'none') THEN 852 786 IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN 853 ALLOCATE( dta_bdy(ib_bdy)% frld(nblen(1)) )854 ALLOCATE( dta_bdy(ib_bdy)%h icif(nblen(1)) )855 ALLOCATE( dta_bdy(ib_bdy)%h snif(nblen(1)) )787 ALLOCATE( dta_bdy(ib_bdy)%a_i(nblen(1),jpl) ) 788 ALLOCATE( dta_bdy(ib_bdy)%h_i(nblen(1),jpl) ) 789 ALLOCATE( dta_bdy(ib_bdy)%h_s(nblen(1),jpl) ) 856 790 ELSE 857 jfld = jfld + 1 858 dta_bdy(ib_bdy)%frld => bf(jfld)%fnow(:,1,1) 859 jfld = jfld + 1 860 dta_bdy(ib_bdy)%hicif => bf(jfld)%fnow(:,1,1) 861 jfld = jfld + 1 862 dta_bdy(ib_bdy)%hsnif => bf(jfld)%fnow(:,1,1) 863 ENDIF 864 ENDIF 865 #elif defined key_lim3 866 IF (cn_ice_lim(ib_bdy) /= 'none') THEN 867 IF( nn_ice_lim_dta(ib_bdy) == 0 ) THEN 868 ALLOCATE( dta_bdy(ib_bdy)%a_i (nblen(1),jpl) ) 869 ALLOCATE( dta_bdy(ib_bdy)%ht_i(nblen(1),jpl) ) 870 ALLOCATE( dta_bdy(ib_bdy)%ht_s(nblen(1),jpl) ) 871 ELSE 872 IF ( ll_bdylim3 ) THEN ! case input is lim3 type 873 jfld = jfld + 1 874 dta_bdy(ib_bdy)%a_i => bf(jfld)%fnow(:,1,:) 875 jfld = jfld + 1 876 dta_bdy(ib_bdy)%ht_i => bf(jfld)%fnow(:,1,:) 877 jfld = jfld + 1 878 dta_bdy(ib_bdy)%ht_s => bf(jfld)%fnow(:,1,:) 879 ELSE ! case input is lim2 type 791 IF ( ll_bdylim3 ) THEN ! case input is Xcat 792 jfld = jfld + 1 793 dta_bdy(ib_bdy)%a_i => bf(jfld)%fnow(:,1,:) 794 jfld = jfld + 1 795 dta_bdy(ib_bdy)%h_i => bf(jfld)%fnow(:,1,:) 796 jfld = jfld + 1 797 dta_bdy(ib_bdy)%h_s => bf(jfld)%fnow(:,1,:) 798 ELSE ! case input is 1cat 880 799 jfld_ai = jfld + 1 881 800 jfld_hti = jfld + 2 882 801 jfld_hts = jfld + 3 883 802 jfld = jfld + 3 884 ALLOCATE( dta_bdy(ib_bdy)%a_i 885 ALLOCATE( dta_bdy(ib_bdy)%h t_i(nblen(1),jpl) )886 ALLOCATE( dta_bdy(ib_bdy)%h t_s(nblen(1),jpl) )887 dta_bdy(ib_bdy)%a_i 888 dta_bdy(ib_bdy)%h t_i(:,:) = 0._wp889 dta_bdy(ib_bdy)%h t_s(:,:) = 0._wp803 ALLOCATE( dta_bdy(ib_bdy)%a_i(nblen(1),jpl) ) 804 ALLOCATE( dta_bdy(ib_bdy)%h_i(nblen(1),jpl) ) 805 ALLOCATE( dta_bdy(ib_bdy)%h_s(nblen(1),jpl) ) 806 dta_bdy(ib_bdy)%a_i(:,:) = 0._wp 807 dta_bdy(ib_bdy)%h_i(:,:) = 0._wp 808 dta_bdy(ib_bdy)%h_s(:,:) = 0._wp 890 809 ENDIF 891 810 -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90
r8733 r8738 351 351 IF(lwp) WRITE(numout,*) 352 352 353 #if defined key_lim 2353 #if defined key_lim3 354 354 IF(lwp) WRITE(numout,*) 'Boundary conditions for sea ice: ' 355 355 SELECT CASE( cn_ice_lim(ib_bdy) ) 356 356 CASE('none') 357 357 IF(lwp) WRITE(numout,*) ' no open boundary condition' 358 dta_bdy(ib_bdy)%ll_ frld= .false.359 dta_bdy(ib_bdy)%ll_h icif= .false.360 dta_bdy(ib_bdy)%ll_h snif= .false.358 dta_bdy(ib_bdy)%ll_a_i = .false. 359 dta_bdy(ib_bdy)%ll_h_i = .false. 360 dta_bdy(ib_bdy)%ll_h_s = .false. 361 361 CASE('frs') 362 362 IF(lwp) WRITE(numout,*) ' Flow Relaxation Scheme' 363 dta_bdy(ib_bdy)%ll_frld = .true. 364 dta_bdy(ib_bdy)%ll_hicif = .true. 365 dta_bdy(ib_bdy)%ll_hsnif = .true. 366 CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for cn_ice_lim' ) 367 END SELECT 368 IF( cn_ice_lim(ib_bdy) /= 'none' ) THEN 369 SELECT CASE( nn_ice_lim_dta(ib_bdy) ) ! 370 CASE( 0 ) ; IF(lwp) WRITE(numout,*) ' initial state used for bdy data' 371 CASE( 1 ) ; IF(lwp) WRITE(numout,*) ' boundary data taken from file' 372 CASE DEFAULT ; CALL ctl_stop( 'nn_ice_lim_dta must be 0 or 1' ) 373 END SELECT 374 ENDIF 375 IF(lwp) WRITE(numout,*) 376 #elif defined key_lim3 377 IF(lwp) WRITE(numout,*) 'Boundary conditions for sea ice: ' 378 SELECT CASE( cn_ice_lim(ib_bdy) ) 379 CASE('none') 380 IF(lwp) WRITE(numout,*) ' no open boundary condition' 381 dta_bdy(ib_bdy)%ll_a_i = .false. 382 dta_bdy(ib_bdy)%ll_ht_i = .false. 383 dta_bdy(ib_bdy)%ll_ht_s = .false. 384 CASE('frs') 385 IF(lwp) WRITE(numout,*) ' Flow Relaxation Scheme' 386 dta_bdy(ib_bdy)%ll_a_i = .true. 387 dta_bdy(ib_bdy)%ll_ht_i = .true. 388 dta_bdy(ib_bdy)%ll_ht_s = .true. 363 dta_bdy(ib_bdy)%ll_a_i = .true. 364 dta_bdy(ib_bdy)%ll_h_i = .true. 365 dta_bdy(ib_bdy)%ll_h_s = .true. 389 366 CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for cn_ice_lim' ) 390 367 END SELECT -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90
r8733 r8738 15 15 16 16 INTERFACE crs_lbc_lnk 17 MODULE PROCEDURE crs_lbc_lnk_3d, crs_lbc_lnk_ 3d_gather, crs_lbc_lnk_2d17 MODULE PROCEDURE crs_lbc_lnk_3d, crs_lbc_lnk_2d 18 18 END INTERFACE 19 19 … … 56 56 ! 57 57 IF( PRESENT( cd_mpp ) ) THEN ; CALL lbc_lnk( pt3d1, cd_type1, psgn, cd_mpp, pval=zval ) 58 ELSE ; CALL lbc_lnk( pt3d1, cd_type1, psgn , pval=zval )58 ELSE ; CALL lbc_lnk( pt3d1, cd_type1, psgn , pval=zval ) 59 59 ENDIF 60 60 ! … … 62 62 ! 63 63 END SUBROUTINE crs_lbc_lnk_3d 64 65 66 SUBROUTINE crs_lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn )67 !!---------------------------------------------------------------------68 !! *** SUBROUTINE crs_lbc_lnk ***69 !!70 !! ** Purpose : set lateral boundary conditions for coarsened grid71 !!72 !! ** Method : Swap domain indices from full to coarse domain73 !! before arguments are passed directly to lbc_lnk.74 !! Upon exiting, switch back to full domain indices.75 !!----------------------------------------------------------------------76 CHARACTER(len=1) , INTENT(in ) :: cd_type1, cd_type2 ! grid type77 REAL(wp) , INTENT(in ) :: psgn ! control of the sign78 REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout) :: pt3d1 , pt3d2 ! 3D array on which the lbc is applied79 !80 LOGICAL :: ll_grid_crs81 !!----------------------------------------------------------------------82 !83 ll_grid_crs = ( jpi == jpi_crs )84 !85 IF( .NOT.ll_grid_crs ) CALL dom_grid_crs ! Save the parent grid information & Switch to coarse grid domain86 !87 CALL lbc_lnk( pt3d1, cd_type1, pt3d2, cd_type2, psgn )88 !89 IF( .NOT.ll_grid_crs ) CALL dom_grid_glo ! Return to parent grid domain90 !91 END SUBROUTINE crs_lbc_lnk_3d_gather92 93 64 94 65 … … 121 92 IF( .NOT.ll_grid_crs ) CALL dom_grid_crs ! Save the parent grid information & Switch to coarse grid domain 122 93 ! 123 IF( PRESENT( cd_mpp ) ) THEN ;CALL lbc_lnk( pt2d, cd_type, psgn, cd_mpp, pval=zval )124 ELSE ; CALL lbc_lnk( pt2d, cd_type, psgn,pval=zval )94 IF( PRESENT( cd_mpp ) ) THEN ; CALL lbc_lnk( pt2d, cd_type, psgn, cd_mpp, pval=zval ) 95 ELSE ; CALL lbc_lnk( pt2d, cd_type, psgn, pval=zval ) 125 96 ENDIF 126 97 ! -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90
r8733 r8738 148 148 rmxln_25h(:,:,:) = mxln(:,:,:) 149 149 #endif 150 #if defined key_lim3 || defined key_lim2150 #if defined key_lim3 151 151 CALL ctl_stop('STOP', 'dia_25h not setup yet to do tidemean ice') 152 152 #endif … … 207 207 ENDIF 208 208 209 #if defined key_lim3 || defined key_lim2209 #if defined key_lim3 210 210 CALL ctl_stop('STOP', 'dia_wri_tide not setup yet to do tidemean ice') 211 211 #endif -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90
r8733 r8738 32 32 USE dianam ! build name of file 33 33 USE lib_mpp ! distributed memory computing library 34 #if defined key_lim235 USE ice_236 #endif37 34 #if defined key_lim3 38 35 USE ice … … 747 744 END DO !end of loop on the level 748 745 749 #if defined key_lim 2 || defined key_lim3746 #if defined key_lim3 750 747 751 748 !ICE CASE … … 769 766 zTnorm=zumid_ice*e2u(k%I,k%J)+zvmid_ice*e1v(k%I,k%J) 770 767 771 #if defined key_lim2772 transports_2d(1,jsec,jseg) = transports_2d(1,jsec,jseg) + (zTnorm)* &773 (1.0 - frld(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J)) &774 *(hsnif(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J) + &775 hicif(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J))776 transports_2d(2,jsec,jseg) = transports_2d(2,jsec,jseg) + (zTnorm)* &777 (1.0 - frld(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J))778 #endif779 768 #if defined key_lim3 780 769 DO jl=1,jpl 781 transports_2d(1,jsec,jseg) = transports_2d(1,jsec,jseg) + (zTnorm)* &782 a_i(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) *&783 ( h t_i(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) + &784 h t_s(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) )770 transports_2d(1,jsec,jseg) = transports_2d(1,jsec,jseg) + (zTnorm)* & 771 a_i(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) * & 772 ( h_i(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) + & 773 h_s(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) ) 785 774 786 775 transports_2d(2,jsec,jseg) = transports_2d(2,jsec,jseg) + (zTnorm)* & 787 a_i(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl)776 a_i(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) 788 777 END DO 789 778 #endif … … 960 949 ENDDO ! loop over jk 961 950 962 #if defined key_lim 2 || defined key_lim3951 #if defined key_lim3 963 952 964 953 !ICE CASE -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r8733 r8738 51 51 USE ioipsl 52 52 53 #if defined key_lim2 54 USE limwri_2 55 #elif defined key_lim3 56 USE limwri 53 #if defined key_lim3 54 USE icewri 57 55 #endif 58 56 USE lib_mpp ! MPP library … … 707 705 #endif 708 706 709 IF( ln_cpl .AND. nn_ice == 2 ) THEN710 CALL histdef( nid_T,"soicetem" , "Ice Surface Temperature" , "K" , & ! tn_ice711 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )712 CALL histdef( nid_T,"soicealb" , "Ice Albedo" , "[0,1]" , & ! alb_ice713 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout )714 ENDIF715 716 707 CALL histend( nid_T, snc4chunks=snc4set ) 717 708 … … 861 852 #endif 862 853 863 IF( ln_cpl .AND. nn_ice == 2 ) THEN864 CALL histwrite( nid_T, "soicetem", it, tn_ice(:,:,1) , ndim_hT, ndex_hT ) ! surf. ice temperature865 CALL histwrite( nid_T, "soicealb", it, alb_ice(:,:,1), ndim_hT, ndex_hT ) ! ice albedo866 ENDIF867 868 854 CALL histwrite( nid_U, "vozocrtx", it, un , ndim_U , ndex_U ) ! i-current 869 855 CALL histwrite( nid_U, "sozotaux", it, utau , ndim_hU, ndex_hU ) ! i-wind stress … … 1009 995 ENDIF 1010 996 1011 #if defined key_lim 21012 CALL lim_wri_state_2( kt, id_i, nh_i )1013 #elif defined key_lim3 1014 CALL lim_wri_state( kt, id_i, nh_i )997 #if defined key_lim3 998 IF( nn_ice == 2 ) THEN ! clem2017: condition in case agrif + lim but no-ice in child grid 999 CALL ice_wri_state( kt, id_i, nh_i ) 1000 ENDIF 1015 1001 #else 1016 1002 CALL histend( id_i, snc4chunks=snc4set ) -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/iscplhsb.F90
r8733 r8738 184 184 END DO 185 185 186 CALL lbc_sum(pvol_flx(:,:,: ),'T',1.) 187 CALL lbc_sum(pts_flx (:,:,:,jp_sal),'T',1.) 188 CALL lbc_sum(pts_flx (:,:,:,jp_tem),'T',1.) 189 186 !!gm ERROR !!!! 187 !! juste use tmask_i or in case of ISF smask_i (to be created to compute the sum without halos) 188 ! 189 ! CALL lbc_sum(pvol_flx(:,:,: ),'T',1.) 190 ! CALL lbc_sum(pts_flx (:,:,:,jp_sal),'T',1.) 191 ! CALL lbc_sum(pts_flx (:,:,:,jp_tem),'T',1.) 192 STOP ' iscpl_cons: please modify this module !' 193 !!gm end 190 194 ! if no neighbour wet cell in case of 2close a cell", need to find the nearest wet point 191 195 ! allocation and initialisation of the list of problematic point … … 283 287 pts_flx (:,:,:,jp_tem) = pts_flx (:,:,:,jp_tem) * tmask(:,:,:) 284 288 285 ! compute sum over the halo and set it to 0. 286 CALL lbc_sum(pvol_flx(:,:,: ),'T',1._wp) 287 CALL lbc_sum(pts_flx (:,:,:,jp_sal),'T',1._wp) 288 CALL lbc_sum(pts_flx (:,:,:,jp_tem),'T',1._wp) 289 !!gm ERROR !!!! 290 !! juste use tmask_i or in case of ISF smask_i (to be created to compute the sum without halos) 291 ! 292 ! ! compute sum over the halo and set it to 0. 293 ! CALL lbc_sum(pvol_flx(:,:,: ),'T',1._wp) 294 ! CALL lbc_sum(pts_flx (:,:,:,jp_sal),'T',1._wp) 295 ! CALL lbc_sum(pts_flx (:,:,:,jp_tem),'T',1._wp) 296 !!gm end 289 297 290 298 ! deallocate variables -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90
r8733 r8738 54 54 55 55 REAL(wp), PUBLIC :: rhosn = 330._wp !: volumic mass of snow [kg/m3] 56 ! MV MP 2016 57 REAL(wp), PUBLIC :: rhofw = 1000._wp !: volumic mass of freshwater in melt ponds [kg/m3] 58 ! END MV MP 2016 56 59 REAL(wp), PUBLIC :: emic = 0.97_wp !: emissivity of snow or ice 57 60 REAL(wp), PUBLIC :: sice = 6.0_wp !: salinity of ice [psu] … … 88 91 REAL(wp), PUBLIC :: r1_rhoic !: 1 / rhoic 89 92 REAL(wp), PUBLIC :: r1_rhosn !: 1 / rhosn 93 REAL(wp), PUBLIC :: r1_cpic !: 1 / cpic 90 94 #endif 91 95 !!---------------------------------------------------------------------- … … 156 160 r1_rhoic = 1._wp / rhoic 157 161 r1_rhosn = 1._wp / rhosn 162 r1_cpic = 1._wp / cpic 158 163 #endif 159 164 IF(lwp) THEN … … 176 181 WRITE(numout,*) ' density of sea ice = ', rhoic , ' kg/m^3' 177 182 WRITE(numout,*) ' density of snow = ', rhosn , ' kg/m^3' 183 WRITE(numout,*) ' density of freshwater (in melt ponds) = ', rhofw , ' kg/m^3' 178 184 WRITE(numout,*) ' emissivity of snow or ice = ', emic 179 185 WRITE(numout,*) ' salinity of ice = ', sice , ' psu' -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/divhor.F90
r8733 r8738 82 82 END DO 83 83 END DO 84 IF( .NOT. AGRIF_Root() ) THEN85 IF( nbondi == 1 .OR. nbondi == 2 ) hdivn(nlci-1, : ,jk) = 0._wp ! east86 IF( nbondi == -1 .OR. nbondi == 2 ) hdivn( 2 , : ,jk) = 0._wp ! west87 IF( nbondj == 1 .OR. nbondj == 2 ) hdivn( : ,nlcj-1,jk) = 0._wp ! north88 IF( nbondj == -1 .OR. nbondj == 2 ) hdivn( : , 2 ,jk) = 0._wp ! south89 ENDIF90 84 END DO 85 #if defined key_agrif 86 IF( .NOT. Agrif_Root() ) THEN 87 IF( nbondi == -1 .OR. nbondi == 2 ) hdivn( 2:nbghostcells+1,: ,:) = 0._wp ! west 88 IF( nbondi == 1 .OR. nbondi == 2 ) hdivn( nlci-nbghostcells:nlci-1,:,:) = 0._wp ! east 89 IF( nbondj == -1 .OR. nbondj == 2 ) hdivn( :,2:nbghostcells+1 ,:) = 0._wp ! south 90 IF( nbondj == 1 .OR. nbondj == 2 ) hdivn( :,nlcj-nbghostcells:nlcj-1,:) = 0._wp ! north 91 ENDIF 92 #endif 91 93 ! 92 94 IF( ln_rnf ) CALL sbc_rnf_div( hdivn ) !== runoffs ==! (update hdivn field) -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
r8733 r8738 17 17 USE phycst ! physical constants 18 18 USE sbc_oce ! surface boundary condition: ocean 19 USE sbc_ice , ONLY : snwice_mass, snwice_mass_b 19 20 USE sbcapr ! surface boundary condition: atmospheric pressure 20 21 USE dynspg_exp ! surface pressure gradient (dyn_spg_exp routine) … … 89 90 IF( ln_apr_dyn & ! atmos. pressure 90 91 .OR. ( .NOT.ln_dynspg_ts .AND. (ln_tide_pot .AND. ln_tide) ) & ! tide potential (no time slitting) 91 .OR. nn_ice_embd == 2 ) THEN! embedded sea-ice92 .OR. ln_ice_embd ) THEN ! embedded sea-ice 92 93 ! 93 94 DO jj = 2, jpjm1 … … 123 124 ENDIF 124 125 ! 125 IF( nn_ice_embd == 2) THEN !== embedded sea ice: Pressure gradient due to snow-ice mass ==!126 IF( ln_ice_embd ) THEN !== embedded sea ice: Pressure gradient due to snow-ice mass ==! 126 127 CALL wrk_alloc( jpi,jpj, zpice ) 127 128 ! -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r8733 r8738 686 686 IF((nbondi == -1).OR.(nbondi == 2)) THEN 687 687 DO jj=1,jpj 688 zwx(2 ,jj) = ubdy_w(jj) * e2u(2,jj)688 zwx(2:nbghostcells+1,jj) = ubdy_w(jj) * e2u(2:nbghostcells+1,jj) 689 689 END DO 690 690 ENDIF 691 691 IF((nbondi == 1).OR.(nbondi == 2)) THEN 692 692 DO jj=1,jpj 693 zwx(nlci- 2,jj) = ubdy_e(jj) * e2u(nlci-2,jj)693 zwx(nlci-nbghostcells-1:nlci-2,jj) = ubdy_e(jj) * e2u(nlci-nbghostcells-1:nlci-2,jj) 694 694 END DO 695 695 ENDIF 696 696 IF((nbondj == -1).OR.(nbondj == 2)) THEN 697 697 DO ji=1,jpi 698 zwy(ji,2 ) = vbdy_s(ji) * e1v(ji,2)698 zwy(ji,2:nbghostcells+1) = vbdy_s(ji) * e1v(ji,2:nbghostcells+1) 699 699 END DO 700 700 ENDIF 701 701 IF((nbondj == 1).OR.(nbondj == 2)) THEN 702 702 DO ji=1,jpi 703 zwy(ji,nlcj- 2) = vbdy_n(ji) * e1v(ji,nlcj-2)703 zwy(ji,nlcj-nbghostcells-1:nlcj-2) = vbdy_n(ji) * e1v(ji,nlcj-nbghostcells-1:nlcj-2) 704 704 END DO 705 705 ENDIF -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icb_oce.F90
r8733 r8738 90 90 REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: ua_e, va_e 91 91 REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: ssh_e 92 #if defined key_lim 2 || defined key_lim3 || defined key_cice92 #if defined key_lim3 || defined key_cice 93 93 REAL(wp), PUBLIC, DIMENSION(:,:), ALLOCATABLE :: ui_e, vi_e 94 94 #endif … … 170 170 ALLOCATE( uo_e(0:jpi+1,0:jpj+1) , ua_e(0:jpi+1,0:jpj+1) , & 171 171 & vo_e(0:jpi+1,0:jpj+1) , va_e(0:jpi+1,0:jpj+1) , & 172 #if defined key_lim 2 || defined key_lim3 || defined key_cice172 #if defined key_lim3 || defined key_cice 173 173 & ui_e(0:jpi+1,0:jpj+1) , & 174 174 & vi_e(0:jpi+1,0:jpj+1) , & -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/ICB/icbutl.F90
r8733 r8738 21 21 USE icb_oce ! define iceberg arrays 22 22 USE sbc_oce ! ocean surface boundary conditions 23 #if defined key_lim2 24 USE ice_2, ONLY: u_ice, v_ice ! LIM-2 ice velocities (CAUTION in C-grid do not use key_vp option) 25 USE ice_2, ONLY: hicif ! LIM-2 ice thickness 26 #elif defined key_lim3 27 USE ice, ONLY: u_ice, v_ice ! LIM-3 variables (always in C-grid) 28 ! gm LIM3 case the mean ice thickness (i.e. averaged over categories) 29 ! gm has to be computed somewhere in the ice and accessed here 23 #if defined key_lim3 24 USE ice, ONLY: u_ice, v_ice, hm_i ! LIM-3 variables 30 25 #endif 31 26 … … 85 80 CALL lbc_lnk_icb( fr_e, 'T', +1._wp, 1, 1 ) 86 81 CALL lbc_lnk_icb( tt_e, 'T', +1._wp, 1, 1 ) 87 #if defined key_lim2 88 hicth(:,:) = 0._wp ; hicth(1:jpi,1:jpj) = hicif(:,:) 89 CALL lbc_lnk_icb(hicth, 'T', +1._wp, 1, 1 ) 90 #endif 91 92 #if defined key_lim2 || defined key_lim3 82 #if defined key_lim3 83 hicth(:,:) = 0._wp ; hicth(1:jpi,1:jpj) = hm_i (:,:) 93 84 ui_e(:,:) = 0._wp ; ui_e(1:jpi, 1:jpj) = u_ice(:,:) 94 85 vi_e(:,:) = 0._wp ; vi_e(1:jpi, 1:jpj) = v_ice(:,:) 95 86 CALL lbc_lnk_icb(hicth, 'T', +1._wp, 1, 1 ) 96 87 CALL lbc_lnk_icb( ui_e, 'U', -1._wp, 1, 1 ) 97 88 CALL lbc_lnk_icb( vi_e, 'V', -1._wp, 1, 1 ) … … 157 148 pva = pva * zmod 158 149 159 #if defined key_lim 2 || defined key_lim3150 #if defined key_lim3 160 151 pui = icb_utl_bilin_h( ui_e, pi, pj, 'U' ) ! sea-ice velocities 161 152 pvi = icb_utl_bilin_h( vi_e, pi, pj, 'V' ) 162 # if defined key_lim3163 phi = 0._wp ! LIM-3 case (to do)164 # else165 153 phi = icb_utl_bilin_h(hicth, pi, pj, 'T' ) ! ice thickness 166 # endif167 154 #else 168 155 pui = 0._wp -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90
r8733 r8738 88 88 INTEGER :: nitrst !: time step at which restart file should be written 89 89 LOGICAL :: lrst_oce !: logical to control the oce restart write 90 LOGICAL :: lrst_ice !: logical to control the ice restart write 90 91 INTEGER :: numror = 0 !: logical unit for ocean restart (read). Init to 0 is needed for SAS (in daymod.F90) 92 INTEGER :: numrir !: logical unit for ice restart (read) 91 93 INTEGER :: numrow !: logical unit for ocean restart (write) 94 INTEGER :: numriw !: logical unit for ice restart (write) 92 95 INTEGER :: nrst_lst !: number of restart to output next 93 96 … … 126 129 INTEGER :: numoni = -1 !: logical unit for Output Namelist Ice 127 130 INTEGER :: numevo_ice = -1 !: logical unit for ice variables (temp. evolution) 128 INTEGER :: num sol = -1 !: logical unit for solverstatistics131 INTEGER :: numrun = -1 !: logical unit for run statistics 129 132 INTEGER :: numdct_in = -1 !: logical unit for transports computing 130 133 INTEGER :: numdct_vol = -1 !: logical unit for voulume transports output -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r8733 r8738 34 34 #if defined key_lim3 35 35 USE ice , ONLY : jpl 36 #elif defined key_lim237 USE par_ice_238 36 #endif 39 37 USE domngb ! ocean space and time domain … … 193 191 CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) ) 194 192 # endif 195 #if defined key_lim3 || defined key_lim2193 #if defined key_lim3 196 194 CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) ) 195 ! SIMIP diagnostics (4 main arctic straits) 196 CALL iom_set_axis_attr( "nstrait", (/ (REAL(ji,wp), ji=1,4) /) ) 197 197 #endif 198 198 CALL iom_set_axis_attr( "icbcla", class_num ) -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90
r8733 r8738 2 2 !!====================================================================== 3 3 !! *** MODULE lbclnk *** 4 !! Ocean: lateral boundary conditions4 !! NEMO : lateral boundary conditions 5 5 !!===================================================================== 6 6 !! History : OPA ! 1997-06 (G. Madec) Original code 7 7 !! NEMO 1.0 ! 2002-09 (G. Madec) F90: Free form and module 8 8 !! 3.2 ! 2009-03 (R. Benshila) External north fold treatment 9 !! 3.5 ! 2012 (S.Mocavero, I. Epicoco) optimization of BDY comm. via lbc_bdy_lnk and lbc_obc_lnk9 !! 3.5 ! 2012 (S.Mocavero, I. Epicoco) optimization of BDY comm. via lbc_bdy_lnk and lbc_obc_lnk 10 10 !! 3.4 ! 2012-12 (R. Bourdalle-Badie, G. Reffray) add a C1D case 11 11 !! 3.6 ! 2015-06 (O. Tintó and M. Castrillo) add lbc_lnk_multi 12 !! 4.0 ! 2017-03 (G. Madec) automatique allocation of array size (use with any 3rd dim size) 13 !! - ! 2017-04 (G. Madec) remove duplicated routines (lbc_lnk_2d_9, lbc_lnk_2d_multiple, lbc_lnk_3d_gather) 14 !! - ! 2017-05 (G. Madec) create generic.h90 files to generate all lbc and north fold routines 12 15 !!---------------------------------------------------------------------- 13 16 #if defined key_mpp_mpi … … 15 18 !! 'key_mpp_mpi' MPI massively parallel processing library 16 19 !!---------------------------------------------------------------------- 17 !! lbc_lnk : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp 18 !! lbc_sum : generic interface for mpp_lnk_sum_3d and mpp_lnk_sum_2d routines defined in lib_mpp 19 !! lbc_lnk_e : generic interface for mpp_lnk_2d_e routine defined in lib_mpp 20 !! lbc_bdy_lnk : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp 21 !!---------------------------------------------------------------------- 20 !! define the generic interfaces of lib_mpp routines 21 !!---------------------------------------------------------------------- 22 !! lbc_lnk : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp 23 !! lbc_lnk_e : generic interface for mpp_lnk_2d_e routine defined in lib_mpp 24 !! lbc_bdy_lnk : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp 25 !!---------------------------------------------------------------------- 26 USE par_oce ! ocean dynamics and tracers 22 27 USE lib_mpp ! distributed memory computing library 23 28 USE lbcnfd ! north fold 29 30 INTERFACE lbc_lnk 31 MODULE PROCEDURE mpp_lnk_2d , mpp_lnk_3d , mpp_lnk_4d 32 END INTERFACE 33 INTERFACE lbc_lnk_ptr 34 MODULE PROCEDURE mpp_lnk_2d_ptr , mpp_lnk_3d_ptr , mpp_lnk_4d_ptr 35 END INTERFACE 24 36 INTERFACE lbc_lnk_multi 25 MODULE PROCEDURE mpp_lnk_2d_9, mpp_lnk_2d_multiple 26 END INTERFACE 27 ! 28 INTERFACE lbc_lnk 29 MODULE PROCEDURE mpp_lnk_3d_gather, mpp_lnk_3d, mpp_lnk_2d 30 END INTERFACE 31 ! 32 INTERFACE lbc_sum 33 MODULE PROCEDURE mpp_lnk_sum_3d, mpp_lnk_sum_2d 37 MODULE PROCEDURE lbc_lnk_2d_multi, lbc_lnk_3d_multi, lbc_lnk_4d_multi 34 38 END INTERFACE 35 39 ! … … 46 50 END INTERFACE 47 51 48 PUBLIC lbc_lnk ! ocean lateral boundary conditions 49 PUBLIC lbc_lnk_multi ! modified ocean lateral boundary conditions 50 PUBLIC lbc_sum 51 PUBLIC lbc_lnk_e ! 52 PUBLIC lbc_lnk ! ocean/ice lateral boundary conditions 53 PUBLIC lbc_lnk_multi ! modified ocean/ice lateral boundary conditions 54 PUBLIC lbc_lnk_e ! extended ocean/ice lateral boundary conditions 52 55 PUBLIC lbc_bdy_lnk ! ocean lateral BDY boundary conditions 53 PUBLIC lbc_lnk_icb ! 54 55 !!---------------------------------------------------------------------- 56 !! NEMO/OPA 3.3 , NEMO Consortium (2010)56 PUBLIC lbc_lnk_icb ! iceberg lateral boundary conditions 57 58 !!---------------------------------------------------------------------- 59 !! NEMO/OPA 4.0 , NEMO Consortium (2017) 57 60 !! $Id$ 58 61 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 59 62 !!---------------------------------------------------------------------- 63 CONTAINS 64 60 65 #else 61 66 !!---------------------------------------------------------------------- 62 67 !! Default option shared memory computing 63 68 !!---------------------------------------------------------------------- 64 !! lbc_sum : generic interface for mpp_lnk_sum_3d and mpp_lnk_sum_2d 69 !! routines setting the appropriate values 70 !! on first and last row and column of the global domain 71 !!---------------------------------------------------------------------- 65 72 !! lbc_lnk_sum_3d: compute sum over the halos on a 3D variable on ocean mesh 66 73 !! lbc_lnk_sum_3d: compute sum over the halos on a 2D variable on ocean mesh … … 70 77 !! lbc_bdy_lnk : set the lateral BDY boundary condition 71 78 !!---------------------------------------------------------------------- 72 USE oce 73 USE dom_oce 74 USE in_out_manager 75 USE lbcnfd 79 USE oce ! ocean dynamics and tracers 80 USE dom_oce ! ocean space and time domain 81 USE in_out_manager ! I/O manager 82 USE lbcnfd ! north fold 76 83 77 84 IMPLICIT NONE … … 79 86 80 87 INTERFACE lbc_lnk 81 MODULE PROCEDURE lbc_lnk_3d_gather, lbc_lnk_3d, lbc_lnk_2d 82 END INTERFACE 83 ! 84 INTERFACE lbc_sum 85 MODULE PROCEDURE lbc_lnk_sum_3d, lbc_lnk_sum_2d 86 END INTERFACE 87 88 MODULE PROCEDURE lbc_lnk_2d , lbc_lnk_3d , lbc_lnk_4d 89 END INTERFACE 90 INTERFACE lbc_lnk_ptr 91 MODULE PROCEDURE lbc_lnk_2d_ptr , lbc_lnk_3d_ptr , lbc_lnk_4d_ptr 92 END INTERFACE 93 INTERFACE lbc_lnk_multi 94 MODULE PROCEDURE lbc_lnk_2d_multi, lbc_lnk_3d_multi, lbc_lnk_4d_multi 95 END INTERFACE 96 ! 88 97 INTERFACE lbc_lnk_e 89 98 MODULE PROCEDURE lbc_lnk_2d_e 90 99 END INTERFACE 91 100 ! 92 INTERFACE lbc_lnk_multi93 MODULE PROCEDURE lbc_lnk_2d_9, lbc_lnk_2d_multiple94 END INTERFACE95 96 101 INTERFACE lbc_bdy_lnk 97 102 MODULE PROCEDURE lbc_bdy_lnk_2d, lbc_bdy_lnk_3d … … 102 107 END INTERFACE 103 108 104 TYPE arrayptr105 REAL , DIMENSION (:,:), POINTER :: pt2d106 END TYPE arrayptr107 PUBLIC arrayptr108 109 109 PUBLIC lbc_lnk ! ocean/ice lateral boundary conditions 110 PUBLIC lbc_sum ! ocean/ice lateral boundary conditions (sum of the overlap region) 111 PUBLIC lbc_lnk_e ! 112 PUBLIC lbc_lnk_multi ! modified ocean lateral boundary conditions 110 PUBLIC lbc_lnk_e ! extended ocean/ice lateral boundary conditions 111 PUBLIC lbc_lnk_multi ! modified ocean/ice lateral boundary conditions 113 112 PUBLIC lbc_bdy_lnk ! ocean lateral BDY boundary conditions 114 PUBLIC lbc_lnk_icb ! 115 116 !!---------------------------------------------------------------------- 117 !! NEMO/OPA 3.7 , NEMO Consortium (2015)113 PUBLIC lbc_lnk_icb ! iceberg lateral boundary conditions 114 115 !!---------------------------------------------------------------------- 116 !! NEMO/OPA 4.0 , NEMO Consortium (2017) 118 117 !! $Id$ 119 118 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 122 121 123 122 # if defined key_c1d 124 !! ----------------------------------------------------------------------123 !!====================================================================== 125 124 !! 'key_c1d' 1D configuration 126 !!---------------------------------------------------------------------- 127 128 SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn ) 129 !!--------------------------------------------------------------------- 130 !! *** ROUTINE lbc_lnk_3d_gather *** 131 !! 132 !! ** Purpose : set lateral boundary conditions on two 3D arrays (C1D case) 133 !! 134 !! ** Method : call lbc_lnk_3d on pt3d1 and pt3d2 135 !!---------------------------------------------------------------------- 136 CHARACTER(len=1) , INTENT(in ) :: cd_type1, cd_type2 ! nature of pt3d grid-points 137 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pt3d1 , pt3d2 ! 3D array on which the lbc is applied 138 REAL(wp) , INTENT(in ) :: psgn ! control of the sign 139 !!---------------------------------------------------------------------- 140 ! 141 CALL lbc_lnk_3d( pt3d1, cd_type1, psgn) 142 CALL lbc_lnk_3d( pt3d2, cd_type2, psgn) 143 ! 144 END SUBROUTINE lbc_lnk_3d_gather 145 125 !!====================================================================== 126 !! central point value replicated over the 8 surrounding points 127 !!---------------------------------------------------------------------- 146 128 147 129 SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval ) … … 153 135 !! ** Method : 1D case, the central water column is set everywhere 154 136 !!---------------------------------------------------------------------- 155 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points156 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pt3d ! 3D array on which the lbc is applied157 REAL(wp) , INTENT(in ) :: psgn ! control of the sign158 CHARACTER(len=3) 159 REAL(wp) 137 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pt3d ! 3D array on which the lbc is applied 138 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points 139 REAL(wp) , INTENT(in ) :: psgn ! sign used across north fold 140 CHARACTER(len=3) , INTENT(in ), OPTIONAL :: cd_mpp ! MPP only (here do nothing) 141 REAL(wp) , INTENT(in ), OPTIONAL :: pval ! background value (for closed boundaries) 160 142 ! 161 143 INTEGER :: jk ! dummy loop index … … 163 145 !!---------------------------------------------------------------------- 164 146 ! 165 DO jk = 1, jpk147 DO jk = 1, SIZE( pt3d, 3 ) 166 148 ztab = pt3d(2,2,jk) 167 149 pt3d(:,:,jk) = ztab … … 179 161 !! ** Method : 1D case, the central water column is set everywhere 180 162 !!---------------------------------------------------------------------- 163 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pt2d ! 2D array on which the lbc is applied 181 164 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points 182 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pt2d ! 2D array on which the lbc is applied 183 REAL(wp) , INTENT(in ) :: psgn ! control of the sign 165 REAL(wp) , INTENT(in ) :: psgn ! sign used across north fold 184 166 CHARACTER(len=3) , INTENT(in ), OPTIONAL :: cd_mpp ! MPP only (here do nothing) 185 167 REAL(wp) , INTENT(in ), OPTIONAL :: pval ! background value (for closed boundaries) … … 193 175 END SUBROUTINE lbc_lnk_2d 194 176 195 SUBROUTINE lbc_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields )196 !!197 INTEGER :: num_fields198 TYPE( arrayptr ), DIMENSION(:) :: pt2d_array199 CHARACTER(len=1), DIMENSION(:), INTENT(in ) :: type_array ! define the nature of ptab array grid-points200 ! ! = T , U , V , F , W and I points201 REAL(wp) , DIMENSION(:), INTENT(in ) :: psgn_array ! =-1 the sign change across the north fold boundary202 ! ! = 1. , the sign is kept203 !204 INTEGER :: ii !!MULTI SEND DUMMY LOOP INDICES205 !206 DO ii = 1, num_fields207 CALL lbc_lnk_2d( pt2d_array(ii)%pt2d, type_array(ii), psgn_array(ii) )208 END DO209 !210 END SUBROUTINE lbc_lnk_2d_multiple211 212 SUBROUTINE lbc_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC &213 & , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF &214 & , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval)215 !!---------------------------------------------------------------------216 ! Second 2D array on which the boundary condition is applied217 REAL(wp), DIMENSION(jpi,jpj), TARGET , INTENT(inout) :: pt2dA218 REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) :: pt2dB , pt2dC , pt2dD , pt2dE219 REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) :: pt2dF , pt2dG , pt2dH , pt2dI220 ! define the nature of ptab array grid-points221 CHARACTER(len=1) , INTENT(in ) :: cd_typeA222 CHARACTER(len=1) , OPTIONAL, INTENT(in ) :: cd_typeB , cd_typeC , cd_typeD , cd_typeE223 CHARACTER(len=1) , OPTIONAL, INTENT(in ) :: cd_typeF , cd_typeG , cd_typeH , cd_typeI224 ! =-1 the sign change across the north fold boundary225 REAL(wp) , INTENT(in ) :: psgnA226 REAL(wp) , OPTIONAL, INTENT(in ) :: psgnB , psgnC , psgnD , psgnE227 REAL(wp) , OPTIONAL, INTENT(in ) :: psgnF , psgnG , psgnH , psgnI228 CHARACTER(len=3) , OPTIONAL, INTENT(in ) :: cd_mpp ! fill the overlap area only229 REAL(wp) , OPTIONAL, INTENT(in ) :: pval ! background value (used at closed boundaries)230 !!231 !!---------------------------------------------------------------------232 233 !!The first array234 CALL lbc_lnk( pt2dA, cd_typeA, psgnA )235 236 !! Look if more arrays to process237 IF(PRESENT (psgnB) )CALL lbc_lnk( pt2dB, cd_typeB, psgnB )238 IF(PRESENT (psgnC) )CALL lbc_lnk( pt2dC, cd_typeC, psgnC )239 IF(PRESENT (psgnD) )CALL lbc_lnk( pt2dD, cd_typeD, psgnD )240 IF(PRESENT (psgnE) )CALL lbc_lnk( pt2dE, cd_typeE, psgnE )241 IF(PRESENT (psgnF) )CALL lbc_lnk( pt2dF, cd_typeF, psgnF )242 IF(PRESENT (psgnG) )CALL lbc_lnk( pt2dG, cd_typeG, psgnG )243 IF(PRESENT (psgnH) )CALL lbc_lnk( pt2dH, cd_typeH, psgnH )244 IF(PRESENT (psgnI) )CALL lbc_lnk( pt2dI, cd_typeI, psgnI )245 246 END SUBROUTINE lbc_lnk_2d_9247 248 249 250 251 252 177 #else 253 !! ----------------------------------------------------------------------178 !!====================================================================== 254 179 !! Default option 3D shared memory computing 255 !!---------------------------------------------------------------------- 256 257 SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn ) 258 !!--------------------------------------------------------------------- 259 !! *** ROUTINE lbc_lnk_3d_gather *** 260 !! 261 !! ** Purpose : set lateral boundary conditions on two 3D arrays (non mpp case) 262 !! 263 !! ** Method : psign = -1 : change the sign across the north fold 264 !! = 1 : no change of the sign across the north fold 265 !! = 0 : no change of the sign across the north fold and 266 !! strict positivity preserved: use inner row/column 267 !! for closed boundaries. 268 !!---------------------------------------------------------------------- 269 CHARACTER(len=1) , INTENT(in ) :: cd_type1, cd_type2 ! nature of pt3d grid-points 270 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pt3d1 , pt3d2 ! 3D array on which the lbc is applied 271 REAL(wp) , INTENT(in ) :: psgn ! control of the sign 272 !!---------------------------------------------------------------------- 273 ! 274 CALL lbc_lnk_3d( pt3d1, cd_type1, psgn) 275 CALL lbc_lnk_3d( pt3d2, cd_type2, psgn) 276 ! 277 END SUBROUTINE lbc_lnk_3d_gather 278 279 280 SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval ) 281 !!--------------------------------------------------------------------- 282 !! *** ROUTINE lbc_lnk_3d *** 283 !! 284 !! ** Purpose : set lateral boundary conditions on a 3D array (non mpp case) 285 !! 286 !! ** Method : psign = -1 : change the sign across the north fold 287 !! = 1 : no change of the sign across the north fold 288 !! = 0 : no change of the sign across the north fold and 289 !! strict positivity preserved: use inner row/column 290 !! for closed boundaries. 291 !!---------------------------------------------------------------------- 292 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points 293 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pt3d ! 3D array on which the lbc is applied 294 REAL(wp) , INTENT(in ) :: psgn ! control of the sign 295 CHARACTER(len=3) , INTENT(in ), OPTIONAL :: cd_mpp ! MPP only (here do nothing) 296 REAL(wp) , INTENT(in ), OPTIONAL :: pval ! background value (for closed boundaries) 297 !! 298 REAL(wp) :: zland 299 !!---------------------------------------------------------------------- 300 301 IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value (zero by default) 302 ELSE ; zland = 0._wp 303 ENDIF 304 305 306 IF( PRESENT( cd_mpp ) ) THEN 307 ! only fill the overlap area and extra allows 308 ! this is in mpp case. In this module, just do nothing 309 ELSE 310 ! ! East-West boundaries 311 ! ! ====================== 312 SELECT CASE ( nperio ) 313 ! 314 CASE ( 1 , 4 , 6 ) !** cyclic east-west 315 pt3d( 1 ,:,:) = pt3d(jpim1,:,:) ! all points 316 pt3d(jpi,:,:) = pt3d( 2 ,:,:) 317 ! 318 CASE DEFAULT !** East closed -- West closed 319 SELECT CASE ( cd_type ) 320 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 321 pt3d( 1 ,:,:) = zland 322 pt3d(jpi,:,:) = zland 323 CASE ( 'F' ) ! F-point 324 pt3d(jpi,:,:) = zland 325 END SELECT 326 ! 327 END SELECT 328 ! ! North-South boundaries 329 ! ! ====================== 330 SELECT CASE ( nperio ) 331 ! 332 CASE ( 2 ) !** South symmetric -- North closed 333 SELECT CASE ( cd_type ) 334 CASE ( 'T' , 'U' , 'W' ) ! T-, U-, W-points 335 pt3d(:, 1 ,:) = pt3d(:,3,:) 336 pt3d(:,jpj,:) = zland 337 CASE ( 'V' , 'F' ) ! V-, F-points 338 pt3d(:, 1 ,:) = psgn * pt3d(:,2,:) 339 pt3d(:,jpj,:) = zland 340 END SELECT 341 ! 342 CASE ( 3 , 4 , 5 , 6 ) !** North fold T or F-point pivot -- South closed 343 SELECT CASE ( cd_type ) ! South : closed 344 CASE ( 'T' , 'U' , 'V' , 'W' , 'I' ) ! all points except F-point 345 pt3d(:, 1 ,:) = zland 346 END SELECT 347 ! ! North fold 348 CALL lbc_nfd( pt3d(:,:,:), cd_type, psgn ) 349 ! 350 CASE DEFAULT !** North closed -- South closed 351 SELECT CASE ( cd_type ) 352 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 353 pt3d(:, 1 ,:) = zland 354 pt3d(:,jpj,:) = zland 355 CASE ( 'F' ) ! F-point 356 pt3d(:,jpj,:) = zland 357 END SELECT 358 ! 359 END SELECT 360 ! 361 ENDIF 362 ! 363 END SUBROUTINE lbc_lnk_3d 364 365 366 SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval ) 367 !!--------------------------------------------------------------------- 368 !! *** ROUTINE lbc_lnk_2d *** 369 !! 370 !! ** Purpose : set lateral boundary conditions on a 2D array (non mpp case) 371 !! 372 !! ** Method : psign = -1 : change the sign across the north fold 373 !! = 1 : no change of the sign across the north fold 374 !! = 0 : no change of the sign across the north fold and 375 !! strict positivity preserved: use inner row/column 376 !! for closed boundaries. 377 !!---------------------------------------------------------------------- 378 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points 379 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pt2d ! 2D array on which the lbc is applied 380 REAL(wp) , INTENT(in ) :: psgn ! control of the sign 381 CHARACTER(len=3) , INTENT(in ), OPTIONAL :: cd_mpp ! MPP only (here do nothing) 382 REAL(wp) , INTENT(in ), OPTIONAL :: pval ! background value (for closed boundaries) 383 !! 384 REAL(wp) :: zland 385 !!---------------------------------------------------------------------- 386 387 IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value (zero by default) 388 ELSE ; zland = 0._wp 389 ENDIF 390 391 IF (PRESENT(cd_mpp)) THEN 392 ! only fill the overlap area and extra allows 393 ! this is in mpp case. In this module, just do nothing 394 ELSE 395 ! ! East-West boundaries 396 ! ! ==================== 397 SELECT CASE ( nperio ) 398 ! 399 CASE ( 1 , 4 , 6 ) !** cyclic east-west 400 pt2d( 1 ,:) = pt2d(jpim1,:) ! all points 401 pt2d(jpi,:) = pt2d( 2 ,:) 402 ! 403 CASE DEFAULT !** East closed -- West closed 404 SELECT CASE ( cd_type ) 405 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 406 pt2d( 1 ,:) = zland 407 pt2d(jpi,:) = zland 408 CASE ( 'F' ) ! F-point 409 pt2d(jpi,:) = zland 410 END SELECT 411 ! 412 END SELECT 413 ! ! North-South boundaries 414 ! ! ====================== 415 SELECT CASE ( nperio ) 416 ! 417 CASE ( 2 ) !** South symmetric -- North closed 418 SELECT CASE ( cd_type ) 419 CASE ( 'T' , 'U' , 'W' ) ! T-, U-, W-points 420 pt2d(:, 1 ) = pt2d(:,3) 421 pt2d(:,jpj) = zland 422 CASE ( 'V' , 'F' ) ! V-, F-points 423 pt2d(:, 1 ) = psgn * pt2d(:,2) 424 pt2d(:,jpj) = zland 425 END SELECT 426 ! 427 CASE ( 3 , 4 , 5 , 6 ) !** North fold T or F-point pivot -- South closed 428 SELECT CASE ( cd_type ) ! South : closed 429 CASE ( 'T' , 'U' , 'V' , 'W' , 'I' ) ! all points except F-point 430 pt2d(:, 1 ) = zland 431 END SELECT 432 ! ! North fold 433 CALL lbc_nfd( pt2d(:,:), cd_type, psgn ) 434 ! 435 CASE DEFAULT !** North closed -- South closed 436 SELECT CASE ( cd_type ) 437 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 438 pt2d(:, 1 ) = zland 439 pt2d(:,jpj) = zland 440 CASE ( 'F' ) ! F-point 441 pt2d(:,jpj) = zland 442 END SELECT 443 ! 444 END SELECT 445 ! 446 ENDIF 447 ! 448 END SUBROUTINE lbc_lnk_2d 449 450 SUBROUTINE lbc_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields ) 451 !! 452 INTEGER :: num_fields 453 TYPE( arrayptr ), DIMENSION(:) :: pt2d_array 454 CHARACTER(len=1), DIMENSION(:), INTENT(in ) :: type_array ! define the nature of ptab array grid-points 455 ! ! = T , U , V , F , W and I points 456 REAL(wp) , DIMENSION(:), INTENT(in ) :: psgn_array ! =-1 the sign change across the north fold boundary 457 ! ! = 1. , the sign is kept 458 ! 459 INTEGER :: ii !!MULTI SEND DUMMY LOOP INDICES 460 ! 461 DO ii = 1, num_fields 462 CALL lbc_lnk_2d( pt2d_array(ii)%pt2d, type_array(ii), psgn_array(ii) ) 463 END DO 464 ! 465 END SUBROUTINE lbc_lnk_2d_multiple 466 467 SUBROUTINE lbc_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC & 468 & , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF & 469 & , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval) 470 !!--------------------------------------------------------------------- 471 ! Second 2D array on which the boundary condition is applied 472 REAL(wp), DIMENSION(jpi,jpj), TARGET , INTENT(inout) :: pt2dA 473 REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) :: pt2dB , pt2dC , pt2dD , pt2dE 474 REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) :: pt2dF , pt2dG , pt2dH , pt2dI 475 ! define the nature of ptab array grid-points 476 CHARACTER(len=1) , INTENT(in ) :: cd_typeA 477 CHARACTER(len=1) , OPTIONAL, INTENT(in ) :: cd_typeB , cd_typeC , cd_typeD , cd_typeE 478 CHARACTER(len=1) , OPTIONAL, INTENT(in ) :: cd_typeF , cd_typeG , cd_typeH , cd_typeI 479 ! =-1 the sign change across the north fold boundary 480 REAL(wp) , INTENT(in ) :: psgnA 481 REAL(wp) , OPTIONAL, INTENT(in ) :: psgnB , psgnC , psgnD , psgnE 482 REAL(wp) , OPTIONAL, INTENT(in ) :: psgnF , psgnG , psgnH , psgnI 483 CHARACTER(len=3) , OPTIONAL, INTENT(in ) :: cd_mpp ! fill the overlap area only 484 REAL(wp) , OPTIONAL, INTENT(in ) :: pval ! background value (used at closed boundaries) 485 !! 486 !!--------------------------------------------------------------------- 487 488 !!The first array 489 CALL lbc_lnk( pt2dA, cd_typeA, psgnA ) 490 491 !! Look if more arrays to process 492 IF(PRESENT (psgnB) )CALL lbc_lnk( pt2dB, cd_typeB, psgnB ) 493 IF(PRESENT (psgnC) )CALL lbc_lnk( pt2dC, cd_typeC, psgnC ) 494 IF(PRESENT (psgnD) )CALL lbc_lnk( pt2dD, cd_typeD, psgnD ) 495 IF(PRESENT (psgnE) )CALL lbc_lnk( pt2dE, cd_typeE, psgnE ) 496 IF(PRESENT (psgnF) )CALL lbc_lnk( pt2dF, cd_typeF, psgnF ) 497 IF(PRESENT (psgnG) )CALL lbc_lnk( pt2dG, cd_typeG, psgnG ) 498 IF(PRESENT (psgnH) )CALL lbc_lnk( pt2dH, cd_typeH, psgnH ) 499 IF(PRESENT (psgnI) )CALL lbc_lnk( pt2dI, cd_typeI, psgnI ) 500 501 END SUBROUTINE lbc_lnk_2d_9 502 503 SUBROUTINE lbc_lnk_sum_2d( pt2d, cd_type, psgn, cd_mpp, pval ) 504 !!--------------------------------------------------------------------- 505 !! *** ROUTINE lbc_lnk_sum_2d *** 506 !! 507 !! ** Purpose : set lateral boundary conditions on a 2D array (non mpp case) 508 !! 509 !! ** Comments: compute the sum of the common cell (overlap region) for the ice sheet/ocean 510 !! coupling if conservation option activated. As no ice shelf are present along 511 !! this line, nothing is done along the north fold. 512 !!---------------------------------------------------------------------- 513 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points 514 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pt2d ! 2D array on which the lbc is applied 515 REAL(wp) , INTENT(in ) :: psgn ! control of the sign 516 CHARACTER(len=3) , INTENT(in ), OPTIONAL :: cd_mpp ! MPP only (here do nothing) 517 REAL(wp) , INTENT(in ), OPTIONAL :: pval ! background value (for closed boundaries) 518 !! 519 REAL(wp) :: zland 520 !!---------------------------------------------------------------------- 521 522 IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value (zero by default) 523 ELSE ; zland = 0._wp 524 ENDIF 525 526 IF (PRESENT(cd_mpp)) THEN 527 ! only fill the overlap area and extra allows 528 ! this is in mpp case. In this module, just do nothing 529 ELSE 530 ! ! East-West boundaries 531 ! ! ==================== 532 SELECT CASE ( nperio ) 533 ! 534 CASE ( 1 , 4 , 6 ) !** cyclic east-west 535 pt2d(jpim1,:) = pt2d(jpim1,:) + pt2d( 1 ,:) 536 pt2d( 2 ,:) = pt2d( 2 ,:) + pt2d(jpi,:) 537 pt2d( 1 ,:) = 0.0_wp ! all points 538 pt2d(jpi,:) = 0.0_wp 539 ! 540 CASE DEFAULT !** East closed -- West closed 541 SELECT CASE ( cd_type ) 542 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 543 pt2d( 1 ,:) = zland 544 pt2d(jpi,:) = zland 545 CASE ( 'F' ) ! F-point 546 pt2d(jpi,:) = zland 547 END SELECT 548 ! 549 END SELECT 550 ! ! North-South boundaries 551 ! ! ====================== 552 ! Nothing to do for the north fold, there is no ice shelf along this line. 553 ! 554 END IF 555 556 END SUBROUTINE 557 558 SUBROUTINE lbc_lnk_sum_3d( pt3d, cd_type, psgn, cd_mpp, pval ) 559 !!--------------------------------------------------------------------- 560 !! *** ROUTINE lbc_lnk_sum_3d *** 561 !! 562 !! ** Purpose : set lateral boundary conditions on a 3D array (non mpp case) 563 !! 564 !! ** Comments: compute the sum of the common cell (overlap region) for the ice sheet/ocean 565 !! coupling if conservation option activated. As no ice shelf are present along 566 !! this line, nothing is done along the north fold. 567 !!---------------------------------------------------------------------- 568 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points 569 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pt3d ! 3D array on which the lbc is applied 570 REAL(wp) , INTENT(in ) :: psgn ! control of the sign 571 CHARACTER(len=3) , INTENT(in ), OPTIONAL :: cd_mpp ! MPP only (here do nothing) 572 REAL(wp) , INTENT(in ), OPTIONAL :: pval ! background value (for closed boundaries) 573 !! 574 REAL(wp) :: zland 575 !!---------------------------------------------------------------------- 576 577 IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value (zero by default) 578 ELSE ; zland = 0._wp 579 ENDIF 580 581 582 IF( PRESENT( cd_mpp ) ) THEN 583 ! only fill the overlap area and extra allows 584 ! this is in mpp case. In this module, just do nothing 585 ELSE 586 ! ! East-West boundaries 587 ! ! ====================== 588 SELECT CASE ( nperio ) 589 ! 590 CASE ( 1 , 4 , 6 ) !** cyclic east-west 591 pt3d(jpim1,:,:) = pt3d(jpim1,:,:) + pt3d( 1 ,:,:) 592 pt3d( 2 ,:,:) = pt3d( 2 ,:,:) + pt3d(jpi,:,:) 593 pt3d( 1 ,:,:) = 0.0_wp ! all points 594 pt3d(jpi,:,:) = 0.0_wp 595 ! 596 CASE DEFAULT !** East closed -- West closed 597 SELECT CASE ( cd_type ) 598 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 599 pt3d( 1 ,:,:) = zland 600 pt3d(jpi,:,:) = zland 601 CASE ( 'F' ) ! F-point 602 pt3d(jpi,:,:) = zland 603 END SELECT 604 ! 605 END SELECT 606 ! ! North-South boundaries 607 ! ! ====================== 608 ! Nothing to do for the north fold, there is no ice shelf along this line. 609 ! 610 END IF 611 END SUBROUTINE 612 613 180 !!====================================================================== 181 !! routines setting land point, or east-west cyclic, 182 !! or north-south cyclic, or north fold values 183 !! on first and last row and column of the global domain 184 !!---------------------------------------------------------------------- 185 186 !!---------------------------------------------------------------------- 187 !! *** routine lbc_lnk_(2,3,4)d *** 188 !! 189 !! * Argument : dummy argument use in lbc_lnk_... routines 190 !! ptab : array or pointer of arrays on which the boundary condition is applied 191 !! cd_nat : nature of array grid-points 192 !! psgn : sign used across the north fold boundary 193 !! kfld : optional, number of pt3d arrays 194 !! cd_mpp : optional, fill the overlap area only 195 !! pval : optional, background value (used at closed boundaries) 196 !!---------------------------------------------------------------------- 197 ! 198 ! !== 2D array and array of 2D pointer ==! 199 ! 200 # define DIM_2d 201 # define ROUTINE_LNK lbc_lnk_2d 202 # include "lbc_lnk_generic.h90" 203 # undef ROUTINE_LNK 204 # define MULTI 205 # define ROUTINE_LNK lbc_lnk_2d_ptr 206 # include "lbc_lnk_generic.h90" 207 # undef ROUTINE_LNK 208 # undef MULTI 209 # undef DIM_2d 210 ! 211 ! !== 3D array and array of 3D pointer ==! 212 ! 213 # define DIM_3d 214 # define ROUTINE_LNK lbc_lnk_3d 215 # include "lbc_lnk_generic.h90" 216 # undef ROUTINE_LNK 217 # define MULTI 218 # define ROUTINE_LNK lbc_lnk_3d_ptr 219 # include "lbc_lnk_generic.h90" 220 # undef ROUTINE_LNK 221 # undef MULTI 222 # undef DIM_3d 223 ! 224 ! !== 4D array and array of 4D pointer ==! 225 ! 226 # define DIM_4d 227 # define ROUTINE_LNK lbc_lnk_4d 228 # include "lbc_lnk_generic.h90" 229 # undef ROUTINE_LNK 230 # define MULTI 231 # define ROUTINE_LNK lbc_lnk_4d_ptr 232 # include "lbc_lnk_generic.h90" 233 # undef ROUTINE_LNK 234 # undef MULTI 235 # undef DIM_4d 236 614 237 #endif 615 238 239 !!====================================================================== 240 !! identical routines in both C1D and shared memory computing 241 !!====================================================================== 242 243 !!---------------------------------------------------------------------- 244 !! *** routine lbc_bdy_lnk_(2,3)d *** 245 !! 246 !! wrapper rountine to 'lbc_lnk_3d'. This wrapper is used 247 !! to maintain the same interface with regards to the mpp case 248 !!---------------------------------------------------------------------- 249 616 250 SUBROUTINE lbc_bdy_lnk_3d( pt3d, cd_type, psgn, ib_bdy ) 617 !!--------------------------------------------------------------------- 618 !! *** ROUTINE lbc_bdy_lnk *** 619 !! 620 !! ** Purpose : wrapper rountine to 'lbc_lnk_3d'. This wrapper is used 621 !! to maintain the same interface with regards to the mpp case 622 !! 623 !!---------------------------------------------------------------------- 624 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points 625 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pt3d ! 3D array on which the lbc is applied 626 REAL(wp) , INTENT(in ) :: psgn ! control of the sign 627 INTEGER , INTENT(in ) :: ib_bdy ! BDY boundary set 628 !!---------------------------------------------------------------------- 629 ! 251 !!---------------------------------------------------------------------- 252 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pt3d ! 3D array on which the lbc is applied 253 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points 254 REAL(wp) , INTENT(in ) :: psgn ! sign used across north fold 255 INTEGER , INTENT(in ) :: ib_bdy ! BDY boundary set 256 !!---------------------------------------------------------------------- 630 257 CALL lbc_lnk_3d( pt3d, cd_type, psgn) 631 !632 258 END SUBROUTINE lbc_bdy_lnk_3d 633 259 634 260 635 261 SUBROUTINE lbc_bdy_lnk_2d( pt2d, cd_type, psgn, ib_bdy ) 636 !!--------------------------------------------------------------------- 637 !! *** ROUTINE lbc_bdy_lnk *** 638 !! 639 !! ** Purpose : wrapper rountine to 'lbc_lnk_3d'. This wrapper is used 640 !! to maintain the same interface with regards to the mpp case 641 !! 642 !!---------------------------------------------------------------------- 643 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points 644 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pt2d ! 3D array on which the lbc is applied 645 REAL(wp) , INTENT(in ) :: psgn ! control of the sign 646 INTEGER , INTENT(in ) :: ib_bdy ! BDY boundary set 647 !!---------------------------------------------------------------------- 648 ! 262 !!---------------------------------------------------------------------- 263 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt2d ! 3D array on which the lbc is applied 264 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points 265 REAL(wp) , INTENT(in ) :: psgn ! sign used across north fold 266 INTEGER , INTENT(in ) :: ib_bdy ! BDY boundary set 267 !!---------------------------------------------------------------------- 649 268 CALL lbc_lnk_2d( pt2d, cd_type, psgn) 650 !651 269 END SUBROUTINE lbc_bdy_lnk_2d 652 270 653 271 654 SUBROUTINE lbc_lnk_2d_e( pt2d, cd_type, psgn, jpri, jprj ) 655 !!--------------------------------------------------------------------- 656 !! *** ROUTINE lbc_lnk_2d *** 657 !! 658 !! ** Purpose : set lateral boundary conditions on a 2D array (non mpp case) 659 !! special dummy routine to allow for use of halo indexing in mpp case 660 !! 661 !! ** Method : psign = -1 : change the sign across the north fold 662 !! = 1 : no change of the sign across the north fold 663 !! = 0 : no change of the sign across the north fold and 664 !! strict positivity preserved: use inner row/column 665 !! for closed boundaries. 666 !!---------------------------------------------------------------------- 667 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points 668 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pt2d ! 2D array on which the lbc is applied 669 REAL(wp) , INTENT(in ) :: psgn ! control of the sign 670 INTEGER , INTENT(in ) :: jpri ! size of extra halo (not needed in non-mpp) 671 INTEGER , INTENT(in ) :: jprj ! size of extra halo (not needed in non-mpp) 672 !!---------------------------------------------------------------------- 673 ! 272 !!gm This routine should be remove with an optional halos size added in orgument of generic routines 273 274 SUBROUTINE lbc_lnk_2d_e( pt2d, cd_type, psgn, ki, kj ) 275 !!---------------------------------------------------------------------- 276 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt2d ! 2D array on which the lbc is applied 277 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points 278 REAL(wp) , INTENT(in ) :: psgn ! sign used across north fold 279 INTEGER , INTENT(in ) :: ki, kj ! sizes of extra halo (not needed in non-mpp) 280 !!---------------------------------------------------------------------- 674 281 CALL lbc_lnk_2d( pt2d, cd_type, psgn ) 675 !676 282 END SUBROUTINE lbc_lnk_2d_e 283 !!gm end 677 284 678 285 #endif 679 286 680 287 !!====================================================================== 288 !! identical routines in both distributed and shared memory computing 289 !!====================================================================== 290 291 !!---------------------------------------------------------------------- 292 !! *** load_ptr_(2,3,4)d *** 293 !! 294 !! * Dummy Argument : 295 !! in ==> ptab ! array to be loaded (2D, 3D or 4D) 296 !! cd_nat ! nature of pt2d array grid-points 297 !! psgn ! sign used across the north fold boundary 298 !! inout <=> ptab_ptr ! array of 2D, 3D or 4D pointers 299 !! cdna_ptr ! nature of ptab array grid-points 300 !! psgn_ptr ! sign used across the north fold boundary 301 !! kfld ! number of elements that has been attributed 302 !!---------------------------------------------------------------------- 303 304 !!---------------------------------------------------------------------- 305 !! *** lbc_lnk_(2,3,4)d_multi *** 306 !! *** load_ptr_(2,3,4)d *** 307 !! 308 !! * Argument : dummy argument use in lbc_lnk_multi_... routines 309 !! 310 !!---------------------------------------------------------------------- 311 312 # define DIM_2d 313 # define ROUTINE_MULTI lbc_lnk_2d_multi 314 # define ROUTINE_LOAD load_ptr_2d 315 # include "lbc_lnk_multi_generic.h90" 316 # undef ROUTINE_MULTI 317 # undef ROUTINE_LOAD 318 # undef DIM_2d 319 320 321 # define DIM_3d 322 # define ROUTINE_MULTI lbc_lnk_3d_multi 323 # define ROUTINE_LOAD load_ptr_3d 324 # include "lbc_lnk_multi_generic.h90" 325 # undef ROUTINE_MULTI 326 # undef ROUTINE_LOAD 327 # undef DIM_3d 328 329 330 # define DIM_4d 331 # define ROUTINE_MULTI lbc_lnk_4d_multi 332 # define ROUTINE_LOAD load_ptr_4d 333 # include "lbc_lnk_multi_generic.h90" 334 # undef ROUTINE_MULTI 335 # undef ROUTINE_LOAD 336 # undef DIM_4d 337 338 !!====================================================================== 681 339 END MODULE lbclnk 682 340 -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90
r8733 r8738 5 5 !!====================================================================== 6 6 !! History : 3.2 ! 2009-03 (R. Benshila) Original code 7 !! 3.5 ! 2013-07 (I. Epicoco, S. Mocavero - CMCC) MPP optimization 7 !! 3.5 ! 2013-07 (I. Epicoco, S. Mocavero - CMCC) MPP optimization 8 !! 4.0 ! 2017-04 (G. Madec) automatique allocation of array argument (use any 3rd dimension) 8 9 !!---------------------------------------------------------------------- 9 10 … … 12 13 !! lbc_nfd_3d : lateral boundary condition: North fold treatment for a 3D arrays (lbc_nfd) 13 14 !! lbc_nfd_2d : lateral boundary condition: North fold treatment for a 2D arrays (lbc_nfd) 14 !! mpp_lbc_nfd_3d : North fold treatment for a 3D arrays optimized for MPP 15 !! mpp_lbc_nfd_2d : North fold treatment for a 2D arrays optimized for MPP 15 !! lbc_nfd_nogather : generic interface for lbc_nfd_nogather_3d and 16 !! lbc_nfd_nogather_2d routines (designed for use 17 !! with ln_nnogather to avoid global width arrays 18 !! mpi all gather operations) 16 19 !!---------------------------------------------------------------------- 17 20 USE dom_oce ! ocean space and time domain … … 22 25 23 26 INTERFACE lbc_nfd 24 MODULE PROCEDURE lbc_nfd_3d, lbc_nfd_2d 27 MODULE PROCEDURE lbc_nfd_2d , lbc_nfd_3d , lbc_nfd_4d 28 MODULE PROCEDURE lbc_nfd_2d_ptr, lbc_nfd_3d_ptr, lbc_nfd_4d_ptr 25 29 END INTERFACE 26 30 ! 27 INTERFACE mpp_lbc_nfd 28 MODULE PROCEDURE mpp_lbc_nfd_3d, mpp_lbc_nfd_2d 31 INTERFACE lbc_nfd_nogather 32 ! ! Currently only 4d array version is needed 33 ! MODULE PROCEDURE lbc_nfd_nogather_2d , lbc_nfd_nogather_3d 34 MODULE PROCEDURE lbc_nfd_nogather_4d 35 ! MODULE PROCEDURE lbc_nfd_nogather_2d_ptr, lbc_nfd_nogather_3d_ptr 36 ! MODULE PROCEDURE lbc_nfd_nogather_4d_ptr 29 37 END INTERFACE 30 38 31 PUBLIC lbc_nfd ! north fold conditions 32 PUBLIC mpp_lbc_nfd ! north fold conditions (parallel case) 39 TYPE, PUBLIC :: PTR_2D !: array of 2D pointers (also used in lib_mpp) 40 REAL(wp), DIMENSION (:,:) , POINTER :: pt2d 41 END TYPE PTR_2D 42 TYPE, PUBLIC :: PTR_3D !: array of 3D pointers (also used in lib_mpp) 43 REAL(wp), DIMENSION (:,:,:) , POINTER :: pt3d 44 END TYPE PTR_3D 45 TYPE, PUBLIC :: PTR_4D !: array of 4D pointers (also used in lib_mpp) 46 REAL(wp), DIMENSION (:,:,:,:), POINTER :: pt4d 47 END TYPE PTR_4D 48 49 PUBLIC lbc_nfd ! north fold conditions 50 PUBLIC lbc_nfd_nogather ! north fold conditions (no allgather case) 33 51 34 52 INTEGER, PUBLIC, PARAMETER :: jpmaxngh = 3 !: … … 43 61 CONTAINS 44 62 45 SUBROUTINE lbc_nfd_3d( pt3d, cd_type, psgn ) 46 !!---------------------------------------------------------------------- 47 !! *** routine lbc_nfd_3d *** 48 !! 49 !! ** Purpose : 3D lateral boundary condition : North fold treatment 50 !! without processor exchanges. 51 !! 52 !! ** Method : 53 !! 54 !! ** Action : pt3d with updated values along the north fold 55 !!---------------------------------------------------------------------- 56 CHARACTER(len=1) , INTENT(in ) :: cd_type ! define the nature of ptab array grid-points 57 ! ! = T , U , V , F , W points 58 REAL(wp) , INTENT(in ) :: psgn ! control of the sign change 59 ! ! = -1. , the sign is changed if north fold boundary 60 ! ! = 1. , the sign is kept if north fold boundary 61 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pt3d ! 3D array on which the boundary condition is applied 62 ! 63 INTEGER :: ji, jk 64 INTEGER :: ijt, iju, ijpj, ijpjm1 65 !!---------------------------------------------------------------------- 66 67 SELECT CASE ( jpni ) 68 CASE ( 1 ) ; ijpj = nlcj ! 1 proc only along the i-direction 69 CASE DEFAULT ; ijpj = 4 ! several proc along the i-direction 70 END SELECT 71 ijpjm1 = ijpj-1 72 73 DO jk = 1, jpk 74 ! 75 SELECT CASE ( npolj ) 76 ! 77 CASE ( 3 , 4 ) ! * North fold T-point pivot 78 ! 79 SELECT CASE ( cd_type ) 80 CASE ( 'T' , 'W' ) ! T-, W-point 81 DO ji = 2, jpiglo 82 ijt = jpiglo-ji+2 83 pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-2,jk) 84 END DO 85 pt3d(1,ijpj,jk) = psgn * pt3d(3,ijpj-2,jk) 86 DO ji = jpiglo/2+1, jpiglo 87 ijt = jpiglo-ji+2 88 pt3d(ji,ijpjm1,jk) = psgn * pt3d(ijt,ijpjm1,jk) 89 END DO 90 CASE ( 'U' ) ! U-point 91 DO ji = 1, jpiglo-1 92 iju = jpiglo-ji+1 93 pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-2,jk) 94 END DO 95 pt3d( 1 ,ijpj,jk) = psgn * pt3d( 2 ,ijpj-2,jk) 96 pt3d(jpiglo,ijpj,jk) = psgn * pt3d(jpiglo-1,ijpj-2,jk) 97 DO ji = jpiglo/2, jpiglo-1 98 iju = jpiglo-ji+1 99 pt3d(ji,ijpjm1,jk) = psgn * pt3d(iju,ijpjm1,jk) 100 END DO 101 CASE ( 'V' ) ! V-point 102 DO ji = 2, jpiglo 103 ijt = jpiglo-ji+2 104 pt3d(ji,ijpj-1,jk) = psgn * pt3d(ijt,ijpj-2,jk) 105 pt3d(ji,ijpj ,jk) = psgn * pt3d(ijt,ijpj-3,jk) 106 END DO 107 pt3d(1,ijpj,jk) = psgn * pt3d(3,ijpj-3,jk) 108 CASE ( 'F' ) ! F-point 109 DO ji = 1, jpiglo-1 110 iju = jpiglo-ji+1 111 pt3d(ji,ijpj-1,jk) = psgn * pt3d(iju,ijpj-2,jk) 112 pt3d(ji,ijpj ,jk) = psgn * pt3d(iju,ijpj-3,jk) 113 END DO 114 pt3d( 1 ,ijpj,jk) = psgn * pt3d( 2 ,ijpj-3,jk) 115 pt3d(jpiglo,ijpj,jk) = psgn * pt3d(jpiglo-1,ijpj-3,jk) 116 END SELECT 117 ! 118 CASE ( 5 , 6 ) ! * North fold F-point pivot 119 ! 120 SELECT CASE ( cd_type ) 121 CASE ( 'T' , 'W' ) ! T-, W-point 122 DO ji = 1, jpiglo 123 ijt = jpiglo-ji+1 124 pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-1,jk) 125 END DO 126 CASE ( 'U' ) ! U-point 127 DO ji = 1, jpiglo-1 128 iju = jpiglo-ji 129 pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-1,jk) 130 END DO 131 pt3d(jpiglo,ijpj,jk) = psgn * pt3d(1,ijpj-1,jk) 132 CASE ( 'V' ) ! V-point 133 DO ji = 1, jpiglo 134 ijt = jpiglo-ji+1 135 pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-2,jk) 136 END DO 137 DO ji = jpiglo/2+1, jpiglo 138 ijt = jpiglo-ji+1 139 pt3d(ji,ijpjm1,jk) = psgn * pt3d(ijt,ijpjm1,jk) 140 END DO 141 CASE ( 'F' ) ! F-point 142 DO ji = 1, jpiglo-1 143 iju = jpiglo-ji 144 pt3d(ji,ijpj ,jk) = psgn * pt3d(iju,ijpj-2,jk) 145 END DO 146 pt3d(jpiglo,ijpj,jk) = psgn * pt3d(1,ijpj-2,jk) 147 DO ji = jpiglo/2+1, jpiglo-1 148 iju = jpiglo-ji 149 pt3d(ji,ijpjm1,jk) = psgn * pt3d(iju,ijpjm1,jk) 150 END DO 151 END SELECT 152 ! 153 CASE DEFAULT ! * closed : the code probably never go through 154 ! 155 SELECT CASE ( cd_type) 156 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 157 pt3d(:, 1 ,jk) = 0.e0 158 pt3d(:,ijpj,jk) = 0.e0 159 CASE ( 'F' ) ! F-point 160 pt3d(:,ijpj,jk) = 0.e0 161 END SELECT 162 ! 163 END SELECT ! npolj 164 ! 165 END DO 166 ! 167 END SUBROUTINE lbc_nfd_3d 168 169 170 SUBROUTINE lbc_nfd_2d( pt2d, cd_type, psgn, pr2dj ) 63 !!---------------------------------------------------------------------- 64 !! *** routine lbc_nfd_(2,3,4)d *** 65 !!---------------------------------------------------------------------- 66 !! 67 !! ** Purpose : lateral boundary condition 68 !! North fold treatment without processor exchanges. 69 !! 70 !! ** Method : 71 !! 72 !! ** Action : ptab with updated values along the north fold 73 !!---------------------------------------------------------------------- 74 ! 75 ! !== 2D array and array of 2D pointer ==! 76 ! 77 # define DIM_2d 78 # define ROUTINE_NFD lbc_nfd_2d 79 # include "lbc_nfd_generic.h90" 80 # undef ROUTINE_NFD 81 # define MULTI 82 # define ROUTINE_NFD lbc_nfd_2d_ptr 83 # include "lbc_nfd_generic.h90" 84 # undef ROUTINE_NFD 85 # undef MULTI 86 # undef DIM_2d 87 ! 88 ! !== 3D array and array of 3D pointer ==! 89 ! 90 # define DIM_3d 91 # define ROUTINE_NFD lbc_nfd_3d 92 # include "lbc_nfd_generic.h90" 93 # undef ROUTINE_NFD 94 # define MULTI 95 # define ROUTINE_NFD lbc_nfd_3d_ptr 96 # include "lbc_nfd_generic.h90" 97 # undef ROUTINE_NFD 98 # undef MULTI 99 # undef DIM_3d 100 ! 101 ! !== 4D array and array of 4D pointer ==! 102 ! 103 # define DIM_4d 104 # define ROUTINE_NFD lbc_nfd_4d 105 # include "lbc_nfd_generic.h90" 106 # undef ROUTINE_NFD 107 # define MULTI 108 # define ROUTINE_NFD lbc_nfd_4d_ptr 109 # include "lbc_nfd_generic.h90" 110 # undef ROUTINE_NFD 111 # undef MULTI 112 # undef DIM_4d 113 ! 114 ! lbc_nfd_nogather routines 115 ! 116 ! !== 2D array and array of 2D pointer ==! 117 ! 118 !# define DIM_2d 119 !# define ROUTINE_NFD lbc_nfd_nogather_2d 120 !# include "lbc_nfd_nogather_generic.h90" 121 !# undef ROUTINE_NFD 122 !# define MULTI 123 !# define ROUTINE_NFD lbc_nfd_nogather_2d_ptr 124 !# include "lbc_nfd_nogather_generic.h90" 125 !# undef ROUTINE_NFD 126 !# undef MULTI 127 !# undef DIM_2d 128 ! 129 ! !== 3D array and array of 3D pointer ==! 130 ! 131 !# define DIM_3d 132 !# define ROUTINE_NFD lbc_nfd_nogather_3d 133 !# include "lbc_nfd_nogather_generic.h90" 134 !# undef ROUTINE_NFD 135 !# define MULTI 136 !# define ROUTINE_NFD lbc_nfd_nogather_3d_ptr 137 !# include "lbc_nfd_nogather_generic.h90" 138 !# undef ROUTINE_NFD 139 !# undef MULTI 140 !# undef DIM_3d 141 ! 142 ! !== 4D array and array of 4D pointer ==! 143 ! 144 # define DIM_4d 145 # define ROUTINE_NFD lbc_nfd_nogather_4d 146 # include "lbc_nfd_nogather_generic.h90" 147 # undef ROUTINE_NFD 148 !# define MULTI 149 !# define ROUTINE_NFD lbc_nfd_nogather_4d_ptr 150 !# include "lbc_nfd_nogather_generic.h90" 151 !# undef ROUTINE_NFD 152 !# undef MULTI 153 # undef DIM_4d 154 155 !!---------------------------------------------------------------------- 156 157 158 !!gm CAUTION HERE optional pr2dj not implemented in generic case 159 !!gm furthermore, in the _org routine it is OK only for T-point pivot !! 160 161 162 SUBROUTINE lbc_nfd_2d_org( pt2d, cd_nat, psgn, pr2dj ) 171 163 !!---------------------------------------------------------------------- 172 164 !! *** routine lbc_nfd_2d *** … … 179 171 !! ** Action : pt2d with updated values along the north fold 180 172 !!---------------------------------------------------------------------- 181 CHARACTER(len=1) , INTENT(in ) :: cd_type ! define the nature of ptab array grid-points182 ! ! = T , U , V , F , W points183 REAL(wp) , INTENT(in ) :: psgn ! control of the sign change184 ! ! = -1. , the sign is changed if north fold boundary185 ! ! = 1. , the sign is kept if north fold boundary186 173 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt2d ! 2D array on which the boundary condition is applied 174 CHARACTER(len=1) , INTENT(in ) :: cd_nat ! nature of pt2d grid-point 175 REAL(wp) , INTENT(in ) :: psgn ! sign used across north fold 187 176 INTEGER , OPTIONAL , INTENT(in ) :: pr2dj ! number of additional halos 188 177 ! … … 210 199 CASE ( 3, 4 ) ! * North fold T-point pivot 211 200 ! 212 SELECT CASE ( cd_ type)201 SELECT CASE ( cd_nat ) 213 202 ! 214 203 CASE ( 'T' , 'W' ) ! T- , W-points … … 265 254 END DO 266 255 END DO 267 CASE ( 'J' ) ! first ice U-V point268 DO jl =0, ipr2dj269 pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl)270 DO ji = 3, jpiglo271 iju = jpiglo - ji + 3272 pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)273 END DO274 END DO275 CASE ( 'K' ) ! second ice U-V point276 DO jl =0, ipr2dj277 pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl)278 DO ji = 3, jpiglo279 iju = jpiglo - ji + 3280 pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)281 END DO282 END DO283 256 END SELECT 284 257 ! 285 258 CASE ( 5, 6 ) ! * North fold F-point pivot 286 259 ! 287 SELECT CASE ( cd_ type)260 SELECT CASE ( cd_nat ) 288 261 CASE ( 'T' , 'W' ) ! T-, W-point 289 262 DO jl = 0, ipr2dj … … 325 298 END DO 326 299 CASE ( 'I' ) ! ice U-V point (I-point) 327 pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0. e0300 pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0._wp 328 301 DO jl = 0, ipr2dj 329 302 DO ji = 2 , jpiglo-1 … … 332 305 END DO 333 306 END DO 334 CASE ( 'J' ) ! first ice U-V point335 pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0336 DO jl = 0, ipr2dj337 DO ji = 2 , jpiglo-1338 ijt = jpiglo - ji + 2339 pt2d(ji,ijpj+jl)= pt2d(ji,ijpj-1-jl)340 END DO341 END DO342 CASE ( 'K' ) ! second ice U-V point343 pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0344 DO jl = 0, ipr2dj345 DO ji = 2 , jpiglo-1346 ijt = jpiglo - ji + 2347 pt2d(ji,ijpj+jl)= pt2d(ijt,ijpj-1-jl)348 END DO349 END DO350 307 END SELECT 351 308 ! 352 309 CASE DEFAULT ! * closed : the code probably never go through 353 310 ! 354 SELECT CASE ( cd_ type)311 SELECT CASE ( cd_nat) 355 312 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 356 pt2d(:, 1:1-ipr2dj ) = 0. e0357 pt2d(:,ijpj:ijpj+ipr2dj) = 0. e0313 pt2d(:, 1:1-ipr2dj ) = 0._wp 314 pt2d(:,ijpj:ijpj+ipr2dj) = 0._wp 358 315 CASE ( 'F' ) ! F-point 359 pt2d(:,ijpj:ijpj+ipr2dj) = 0. e0316 pt2d(:,ijpj:ijpj+ipr2dj) = 0._wp 360 317 CASE ( 'I' ) ! ice U-V point 361 pt2d(:, 1:1-ipr2dj ) = 0.e0 362 pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0 363 CASE ( 'J' ) ! first ice U-V point 364 pt2d(:, 1:1-ipr2dj ) = 0.e0 365 pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0 366 CASE ( 'K' ) ! second ice U-V point 367 pt2d(:, 1:1-ipr2dj ) = 0.e0 368 pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0 318 pt2d(:, 1:1-ipr2dj ) = 0._wp 319 pt2d(:,ijpj:ijpj+ipr2dj) = 0._wp 369 320 END SELECT 370 321 ! 371 322 END SELECT 372 323 ! 373 END SUBROUTINE lbc_nfd_2d 374 375 376 SUBROUTINE mpp_lbc_nfd_3d( pt3dl, pt3dr, cd_type, psgn ) 377 !!---------------------------------------------------------------------- 378 !! *** routine mpp_lbc_nfd_3d *** 379 !! 380 !! ** Purpose : 3D lateral boundary condition : North fold treatment 381 !! without processor exchanges. 382 !! 383 !! ** Method : 384 !! 385 !! ** Action : pt3d with updated values along the north fold 386 !!---------------------------------------------------------------------- 387 CHARACTER(len=1) , INTENT(in ) :: cd_type ! define the nature of ptab array grid-points 388 ! ! = T , U , V , F , W points 389 REAL(wp) , INTENT(in ) :: psgn ! control of the sign change 390 ! ! = -1. , the sign is changed if north fold boundary 391 ! ! = 1. , the sign is kept if north fold boundary 392 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: pt3dl ! 3D array on which the boundary condition is applied 393 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pt3dr ! 3D array on which the boundary condition is applied 394 ! 395 INTEGER :: ji, jk 396 INTEGER :: ijt, iju, ijpj, ijpjm1, ijta, ijua, jia, startloop, endloop 397 !!---------------------------------------------------------------------- 398 ! 399 SELECT CASE ( jpni ) 400 CASE ( 1 ) ; ijpj = nlcj ! 1 proc only along the i-direction 401 CASE DEFAULT ; ijpj = 4 ! several proc along the i-direction 402 END SELECT 403 ijpjm1 = ijpj-1 404 405 ! 406 SELECT CASE ( npolj ) 407 ! 408 CASE ( 3 , 4 ) ! * North fold T-point pivot 409 ! 410 SELECT CASE ( cd_type ) 411 CASE ( 'T' , 'W' ) ! T-, W-point 412 IF (nimpp .ne. 1) THEN 413 startloop = 1 414 ELSE 415 startloop = 2 416 ENDIF 417 418 DO jk = 1, jpk 419 DO ji = startloop, nlci 420 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 421 pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-2,jk) 422 END DO 423 IF(nimpp .eq. 1) THEN 424 pt3dl(1,ijpj,jk) = psgn * pt3dl(3,ijpj-2,jk) 425 ENDIF 426 END DO 427 428 IF(nimpp .ge. (jpiglo/2+1)) THEN 429 startloop = 1 430 ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN 431 startloop = jpiglo/2+1 - nimpp + 1 432 ELSE 433 startloop = nlci + 1 434 ENDIF 435 IF(startloop .le. nlci) THEN 436 DO jk = 1, jpk 437 DO ji = startloop, nlci 438 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 439 jia = ji + nimpp - 1 440 ijta = jpiglo - jia + 2 441 IF((ijta .ge. (startloop + nimpp - 1)) .and. (ijta .lt. jia)) THEN 442 pt3dl(ji,ijpjm1,jk) = psgn * pt3dl(ijta-nimpp+1,ijpjm1,jk) 443 ELSE 444 pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(ijt,ijpjm1,jk) 445 ENDIF 446 END DO 447 END DO 448 ENDIF 449 450 451 CASE ( 'U' ) ! U-point 452 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 453 endloop = nlci 454 ELSE 455 endloop = nlci - 1 456 ENDIF 457 DO jk = 1, jpk 458 DO ji = 1, endloop 459 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 460 pt3dl(ji,ijpj,jk) = psgn * pt3dr(iju,ijpj-2,jk) 461 END DO 462 IF(nimpp .eq. 1) THEN 463 pt3dl( 1 ,ijpj,jk) = psgn * pt3dl( 2 ,ijpj-2,jk) 464 ENDIF 465 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 466 pt3dl(nlci,ijpj,jk) = psgn * pt3dl(nlci-1,ijpj-2,jk) 467 ENDIF 468 END DO 469 470 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 471 endloop = nlci 472 ELSE 473 endloop = nlci - 1 474 ENDIF 475 IF(nimpp .ge. (jpiglo/2)) THEN 476 startloop = 1 477 ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2)) .AND. (nimpp .lt. (jpiglo/2))) THEN 478 startloop = jpiglo/2 - nimpp + 1 479 ELSE 480 startloop = endloop + 1 481 ENDIF 482 IF (startloop .le. endloop) THEN 483 DO jk = 1, jpk 484 DO ji = startloop, endloop 485 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 486 jia = ji + nimpp - 1 487 ijua = jpiglo - jia + 1 488 IF((ijua .ge. (startloop + nimpp - 1)) .and. (ijua .lt. jia)) THEN 489 pt3dl(ji,ijpjm1,jk) = psgn * pt3dl(ijua-nimpp+1,ijpjm1,jk) 490 ELSE 491 pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(iju,ijpjm1,jk) 492 ENDIF 493 END DO 494 END DO 495 ENDIF 496 497 CASE ( 'V' ) ! V-point 498 IF (nimpp .ne. 1) THEN 499 startloop = 1 500 ELSE 501 startloop = 2 502 ENDIF 503 DO jk = 1, jpk 504 DO ji = startloop, nlci 505 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 506 pt3dl(ji,ijpj-1,jk) = psgn * pt3dr(ijt,ijpj-2,jk) 507 pt3dl(ji,ijpj ,jk) = psgn * pt3dr(ijt,ijpj-3,jk) 508 END DO 509 IF(nimpp .eq. 1) THEN 510 pt3dl(1,ijpj,jk) = psgn * pt3dl(3,ijpj-3,jk) 511 ENDIF 512 END DO 513 CASE ( 'F' ) ! F-point 514 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 515 endloop = nlci 516 ELSE 517 endloop = nlci - 1 518 ENDIF 519 DO jk = 1, jpk 520 DO ji = 1, endloop 521 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 522 pt3dl(ji,ijpj-1,jk) = psgn * pt3dr(iju,ijpj-2,jk) 523 pt3dl(ji,ijpj ,jk) = psgn * pt3dr(iju,ijpj-3,jk) 524 END DO 525 IF(nimpp .eq. 1) THEN 526 pt3dl( 1 ,ijpj,jk) = psgn * pt3dl( 2 ,ijpj-3,jk) 527 ENDIF 528 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 529 pt3dl(nlci,ijpj,jk) = psgn * pt3dl(nlci-1,ijpj-3,jk) 530 ENDIF 531 END DO 532 END SELECT 533 ! 534 535 CASE ( 5 , 6 ) ! * North fold F-point pivot 536 ! 537 SELECT CASE ( cd_type ) 538 CASE ( 'T' , 'W' ) ! T-, W-point 539 DO jk = 1, jpk 540 DO ji = 1, nlci 541 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 542 pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-1,jk) 543 END DO 544 END DO 545 546 CASE ( 'U' ) ! U-point 547 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 548 endloop = nlci 549 ELSE 550 endloop = nlci - 1 551 ENDIF 552 DO jk = 1, jpk 553 DO ji = 1, endloop 554 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 555 pt3dl(ji,ijpj,jk) = psgn * pt3dr(iju,ijpj-1,jk) 556 END DO 557 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 558 pt3dl(nlci,ijpj,jk) = psgn * pt3dr(1,ijpj-1,jk) 559 ENDIF 560 END DO 561 562 CASE ( 'V' ) ! V-point 563 DO jk = 1, jpk 564 DO ji = 1, nlci 565 ijt = jpiglo - ji- nimpp - nfiimpp(isendto(1),jpnj) + 3 566 pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-2,jk) 567 END DO 568 END DO 569 570 IF(nimpp .ge. (jpiglo/2+1)) THEN 571 startloop = 1 572 ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN 573 startloop = jpiglo/2+1 - nimpp + 1 574 ELSE 575 startloop = nlci + 1 576 ENDIF 577 IF(startloop .le. nlci) THEN 578 DO jk = 1, jpk 579 DO ji = startloop, nlci 580 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 581 pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(ijt,ijpjm1,jk) 582 END DO 583 END DO 584 ENDIF 585 586 CASE ( 'F' ) ! F-point 587 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 588 endloop = nlci 589 ELSE 590 endloop = nlci - 1 591 ENDIF 592 DO jk = 1, jpk 593 DO ji = 1, endloop 594 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 595 pt3dl(ji,ijpj ,jk) = psgn * pt3dr(iju,ijpj-2,jk) 596 END DO 597 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 598 pt3dl(nlci,ijpj,jk) = psgn * pt3dr(1,ijpj-2,jk) 599 ENDIF 600 END DO 601 602 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 603 endloop = nlci 604 ELSE 605 endloop = nlci - 1 606 ENDIF 607 IF(nimpp .ge. (jpiglo/2+1)) THEN 608 startloop = 1 609 ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN 610 startloop = jpiglo/2+1 - nimpp + 1 611 ELSE 612 startloop = endloop + 1 613 ENDIF 614 IF (startloop .le. endloop) THEN 615 DO jk = 1, jpk 616 DO ji = startloop, endloop 617 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 618 pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(iju,ijpjm1,jk) 619 END DO 620 END DO 621 ENDIF 622 623 END SELECT 624 625 CASE DEFAULT ! * closed : the code probably never go through 626 ! 627 SELECT CASE ( cd_type) 628 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 629 pt3dl(:, 1 ,jk) = 0.e0 630 pt3dl(:,ijpj,jk) = 0.e0 631 CASE ( 'F' ) ! F-point 632 pt3dl(:,ijpj,jk) = 0.e0 633 END SELECT 634 ! 635 END SELECT ! npolj 636 ! 637 ! 638 END SUBROUTINE mpp_lbc_nfd_3d 639 640 641 SUBROUTINE mpp_lbc_nfd_2d( pt2dl, pt2dr, cd_type, psgn ) 642 !!---------------------------------------------------------------------- 643 !! *** routine mpp_lbc_nfd_2d *** 644 !! 645 !! ** Purpose : 2D lateral boundary condition : North fold treatment 646 !! without processor exchanges. 647 !! 648 !! ** Method : 649 !! 650 !! ** Action : pt2d with updated values along the north fold 651 !!---------------------------------------------------------------------- 652 CHARACTER(len=1) , INTENT(in ) :: cd_type ! define the nature of ptab array grid-points 653 ! ! = T , U , V , F , W points 654 REAL(wp) , INTENT(in ) :: psgn ! control of the sign change 655 ! ! = -1. , the sign is changed if north fold boundary 656 ! ! = 1. , the sign is kept if north fold boundary 657 REAL(wp), DIMENSION(:,:), INTENT(inout) :: pt2dl ! 2D array on which the boundary condition is applied 658 REAL(wp), DIMENSION(:,:), INTENT(in ) :: pt2dr ! 2D array on which the boundary condition is applied 659 ! 660 INTEGER :: ji 661 INTEGER :: ijt, iju, ijpj, ijpjm1, ijta, ijua, jia, startloop, endloop 662 !!---------------------------------------------------------------------- 663 664 SELECT CASE ( jpni ) 665 CASE ( 1 ) ; ijpj = nlcj ! 1 proc only along the i-direction 666 CASE DEFAULT ; ijpj = 4 ! several proc along the i-direction 667 END SELECT 668 ! 669 ijpjm1 = ijpj-1 670 671 672 SELECT CASE ( npolj ) 673 ! 674 CASE ( 3, 4 ) ! * North fold T-point pivot 675 ! 676 SELECT CASE ( cd_type ) 677 ! 678 CASE ( 'T' , 'W' ) ! T- , W-points 679 IF (nimpp .ne. 1) THEN 680 startloop = 1 681 ELSE 682 startloop = 2 683 ENDIF 684 DO ji = startloop, nlci 685 ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 686 pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1) 687 END DO 688 IF (nimpp .eq. 1) THEN 689 pt2dl(1,ijpj) = psgn * pt2dl(3,ijpj-2) 690 ENDIF 691 692 IF(nimpp .ge. (jpiglo/2+1)) THEN 693 startloop = 1 694 ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN 695 startloop = jpiglo/2+1 - nimpp + 1 696 ELSE 697 startloop = nlci + 1 698 ENDIF 699 DO ji = startloop, nlci 700 ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 701 jia = ji + nimpp - 1 702 ijta = jpiglo - jia + 2 703 IF((ijta .ge. (startloop + nimpp - 1)) .and. (ijta .lt. jia)) THEN 704 pt2dl(ji,ijpjm1) = psgn * pt2dl(ijta-nimpp+1,ijpjm1) 705 ELSE 706 pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1) 707 ENDIF 708 END DO 709 710 CASE ( 'U' ) ! U-point 711 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 712 endloop = nlci 713 ELSE 714 endloop = nlci - 1 715 ENDIF 716 DO ji = 1, endloop 717 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 718 pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1) 719 END DO 720 721 IF (nimpp .eq. 1) THEN 722 pt2dl( 1 ,ijpj ) = psgn * pt2dl( 2 ,ijpj-2) 723 pt2dl(1 ,ijpj-1) = psgn * pt2dr(jpiglo - nfiimpp(isendto(1), jpnj) + 1, ijpj-1) 724 ENDIF 725 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 726 pt2dl(nlci,ijpj ) = psgn * pt2dl(nlci-1,ijpj-2) 727 ENDIF 728 729 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 730 endloop = nlci 731 ELSE 732 endloop = nlci - 1 733 ENDIF 734 IF(nimpp .ge. (jpiglo/2)) THEN 735 startloop = 1 736 ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2)) .AND. (nimpp .lt. (jpiglo/2))) THEN 737 startloop = jpiglo/2 - nimpp + 1 738 ELSE 739 startloop = endloop + 1 740 ENDIF 741 DO ji = startloop, endloop 742 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 743 jia = ji + nimpp - 1 744 ijua = jpiglo - jia + 1 745 IF((ijua .ge. (startloop + nimpp - 1)) .and. (ijua .lt. jia)) THEN 746 pt2dl(ji,ijpjm1) = psgn * pt2dl(ijua-nimpp+1,ijpjm1) 747 ELSE 748 pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1) 749 ENDIF 750 END DO 751 752 CASE ( 'V' ) ! V-point 753 IF (nimpp .ne. 1) THEN 754 startloop = 1 755 ELSE 756 startloop = 2 757 ENDIF 758 DO ji = startloop, nlci 759 ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 760 pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1-1) 761 pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-2) 762 END DO 763 IF (nimpp .eq. 1) THEN 764 pt2dl( 1 ,ijpj) = psgn * pt2dl( 3 ,ijpj-3) 765 ENDIF 766 767 CASE ( 'F' ) ! F-point 768 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 769 endloop = nlci 770 ELSE 771 endloop = nlci - 1 772 ENDIF 773 DO ji = 1, endloop 774 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 775 pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1-1) 776 pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-2) 777 END DO 778 IF (nimpp .eq. 1) THEN 779 pt2dl( 1 ,ijpj) = psgn * pt2dl( 2 ,ijpj-3) 780 pt2dl( 1 ,ijpj-1) = psgn * pt2dl( 2 ,ijpj-2) 781 ENDIF 782 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 783 pt2dl(nlci,ijpj) = psgn * pt2dl(nlci-1,ijpj-3) 784 pt2dl(nlci,ijpj-1) = psgn * pt2dl(nlci-1,ijpj-2) 785 ENDIF 786 787 CASE ( 'I' ) ! ice U-V point (I-point) 788 IF (nimpp .ne. 1) THEN 789 startloop = 1 790 ELSE 791 startloop = 3 792 pt2dl(2,ijpj) = psgn * pt2dr(3,ijpjm1) 793 ENDIF 794 DO ji = startloop, nlci 795 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5 796 pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 797 END DO 798 799 CASE ( 'J' ) ! first ice U-V point 800 IF (nimpp .ne. 1) THEN 801 startloop = 1 802 ELSE 803 startloop = 3 804 pt2dl(2,ijpj) = psgn * pt2dl(3,ijpjm1) 805 ENDIF 806 DO ji = startloop, nlci 807 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5 808 pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 809 END DO 810 811 CASE ( 'K' ) ! second ice U-V point 812 IF (nimpp .ne. 1) THEN 813 startloop = 1 814 ELSE 815 startloop = 3 816 pt2dl(2,ijpj) = psgn * pt2dl(3,ijpjm1) 817 ENDIF 818 DO ji = startloop, nlci 819 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5 820 pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 821 END DO 822 823 END SELECT 824 ! 825 CASE ( 5, 6 ) ! * North fold F-point pivot 826 ! 827 SELECT CASE ( cd_type ) 828 CASE ( 'T' , 'W' ) ! T-, W-point 829 DO ji = 1, nlci 830 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 831 pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1) 832 END DO 833 834 CASE ( 'U' ) ! U-point 835 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 836 endloop = nlci 837 ELSE 838 endloop = nlci - 1 839 ENDIF 840 DO ji = 1, endloop 841 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 842 pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 843 END DO 844 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 845 pt2dl(nlci,ijpj) = psgn * pt2dr(1,ijpj-1) 846 ENDIF 847 848 CASE ( 'V' ) ! V-point 849 DO ji = 1, nlci 850 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 851 pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1) 852 END DO 853 IF(nimpp .ge. (jpiglo/2+1)) THEN 854 startloop = 1 855 ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN 856 startloop = jpiglo/2+1 - nimpp + 1 857 ELSE 858 startloop = nlci + 1 859 ENDIF 860 DO ji = startloop, nlci 861 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 862 pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1) 863 END DO 864 865 CASE ( 'F' ) ! F-point 866 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 867 endloop = nlci 868 ELSE 869 endloop = nlci - 1 870 ENDIF 871 DO ji = 1, endloop 872 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 873 pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1) 874 END DO 875 IF((nimpp + nlci - 1) .eq. jpiglo) THEN 876 pt2dl(nlci,ijpj) = psgn * pt2dr(1,ijpj-2) 877 ENDIF 878 879 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 880 endloop = nlci 881 ELSE 882 endloop = nlci - 1 883 ENDIF 884 IF(nimpp .ge. (jpiglo/2+1)) THEN 885 startloop = 1 886 ELSEIF(((nimpp+nlci-1) .ge. (jpiglo/2+1)) .AND. (nimpp .lt. (jpiglo/2+1))) THEN 887 startloop = jpiglo/2+1 - nimpp + 1 888 ELSE 889 startloop = endloop + 1 890 ENDIF 891 892 DO ji = startloop, endloop 893 iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 894 pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1) 895 END DO 896 897 CASE ( 'I' ) ! ice U-V point (I-point) 898 IF (nimpp .ne. 1) THEN 899 startloop = 1 900 ELSE 901 startloop = 2 902 ENDIF 903 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 904 endloop = nlci 905 ELSE 906 endloop = nlci - 1 907 ENDIF 908 DO ji = startloop , endloop 909 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 910 pt2dl(ji,ijpj)= 0.5 * (pt2dl(ji,ijpjm1) + psgn * pt2dr(ijt,ijpjm1)) 911 END DO 912 913 CASE ( 'J' ) ! first ice U-V point 914 IF (nimpp .ne. 1) THEN 915 startloop = 1 916 ELSE 917 startloop = 2 918 ENDIF 919 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 920 endloop = nlci 921 ELSE 922 endloop = nlci - 1 923 ENDIF 924 DO ji = startloop , endloop 925 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 926 pt2dl(ji,ijpj) = pt2dl(ji,ijpjm1) 927 END DO 928 929 CASE ( 'K' ) ! second ice U-V point 930 IF (nimpp .ne. 1) THEN 931 startloop = 1 932 ELSE 933 startloop = 2 934 ENDIF 935 IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 936 endloop = nlci 937 ELSE 938 endloop = nlci - 1 939 ENDIF 940 DO ji = startloop, endloop 941 ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 942 pt2dl(ji,ijpj) = pt2dr(ijt,ijpjm1) 943 END DO 944 945 END SELECT 946 ! 947 CASE DEFAULT ! * closed : the code probably never go through 948 ! 949 SELECT CASE ( cd_type) 950 CASE ( 'T' , 'U' , 'V' , 'W' ) ! T-, U-, V-, W-points 951 pt2dl(:, 1 ) = 0.e0 952 pt2dl(:,ijpj) = 0.e0 953 CASE ( 'F' ) ! F-point 954 pt2dl(:,ijpj) = 0.e0 955 CASE ( 'I' ) ! ice U-V point 956 pt2dl(:, 1 ) = 0.e0 957 pt2dl(:,ijpj) = 0.e0 958 CASE ( 'J' ) ! first ice U-V point 959 pt2dl(:, 1 ) = 0.e0 960 pt2dl(:,ijpj) = 0.e0 961 CASE ( 'K' ) ! second ice U-V point 962 pt2dl(:, 1 ) = 0.e0 963 pt2dl(:,ijpj) = 0.e0 964 END SELECT 965 ! 966 END SELECT 967 ! 968 END SUBROUTINE mpp_lbc_nfd_2d 324 END SUBROUTINE lbc_nfd_2d_org 969 325 970 326 !!====================================================================== -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r8733 r8738 8 8 !! 8.0 ! 1998 (M. Imbard, J. Escobar, L. Colombet ) SHMEM and MPI 9 9 !! ! 1998 (J.M. Molines) Open boundary conditions 10 !! NEMO 1.0 ! 2003 (J. -M. Molines, G. Madec) F90, free form10 !! NEMO 1.0 ! 2003 (J.M. Molines, G. Madec) F90, free form 11 11 !! ! 2003 (J.M. Molines) add mpp_ini_north(_3d,_2d) 12 12 !! - ! 2004 (R. Bourdalle Badie) isend option in mpi … … 19 19 !! 3.2 ! 2009 (O. Marti) add mpp_ini_znl 20 20 !! 4.0 ! 2011 (G. Madec) move ctl_ routines from in_out_manager 21 !! 3.5 ! 2012 (S.Mocavero, I. Epicoco) Add 'mpp_lnk_bdy_3d', 'mpp_lnk_obc_3d', 22 !! 'mpp_lnk_bdy_2d' and 'mpp_lnk_obc_2d' routines and update 23 !! the mppobc routine to optimize the BDY and OBC communications 24 !! 3.5 ! 2013 ( C. Ethe, G. Madec ) message passing arrays as local variables 21 !! 3.5 ! 2012 (S.Mocavero, I. Epicoco) Add mpp_lnk_bdy_3d/2d routines to optimize the BDY comm. 22 !! 3.5 ! 2013 (C. Ethe, G. Madec) message passing arrays as local variables 25 23 !! 3.5 ! 2013 (S.Mocavero, I.Epicoco - CMCC) north fold optimizations 26 !! 3.6 ! 2015 (O. Tintó and M. Castrillo - BSC) Added 'mpp_lnk_2d_multiple', 'mpp_lbc_north_2d_multiple', 'mpp_max_multiple' 24 !! 3.6 ! 2015 (O. Tintó and M. Castrillo - BSC) Added '_multiple' case for 2D lbc and max 25 !! 4.0 ! 2017 (G. Madec) automatique allocation of array argument (use any 3rd dimension) 26 !! - ! 2017 (G. Madec) create generic.h90 files to generate all lbc and north fold routines 27 27 !!---------------------------------------------------------------------- 28 28 … … 41 41 !! mynode : indentify the processor unit 42 42 !! mpp_lnk : interface (defined in lbclnk) for message passing of 2d or 3d arrays (mpp_lnk_2d, mpp_lnk_3d) 43 !! mpp_lnk_3d_gather : Message passing manadgement for two 3D arrays44 43 !! mpp_lnk_e : interface (defined in lbclnk) for message passing of 2d array with extra halo (mpp_lnk_2d_e) 45 44 !! mpp_lnk_icb : interface for message passing of 2d arrays with extra halo for icebergs (mpp_lnk_2d_icb) 46 45 !! mpprecv : 47 !! mppsend : SUBROUTINE mpp_ini_znl46 !! mppsend : 48 47 !! mppscatter : 49 48 !! mppgather : … … 56 55 !! mppstop : 57 56 !! mpp_ini_north : initialisation of north fold 58 !! mpp_lbc_north : north fold processors gathering57 !!gm !! mpp_lbc_north : north fold processors gathering 59 58 !! mpp_lbc_north_e : variant of mpp_lbc_north for extra outer halo 60 59 !! mpp_lbc_north_icb : variant of mpp_lbc_north for extra outer halo with icebergs … … 67 66 IMPLICIT NONE 68 67 PRIVATE 69 68 69 INTERFACE mpp_nfd 70 MODULE PROCEDURE mpp_nfd_2d , mpp_nfd_3d , mpp_nfd_4d 71 MODULE PROCEDURE mpp_nfd_2d_ptr, mpp_nfd_3d_ptr, mpp_nfd_4d_ptr 72 END INTERFACE 73 74 ! Interface associated to the mpp_lnk_... routines is defined in lbclnk 75 PUBLIC mpp_lnk_2d , mpp_lnk_3d , mpp_lnk_4d 76 PUBLIC mpp_lnk_2d_ptr, mpp_lnk_3d_ptr, mpp_lnk_4d_ptr 77 PUBLIC mpp_lnk_2d_e 78 ! 79 !!gm this should be useless 80 PUBLIC mpp_nfd_2d , mpp_nfd_3d , mpp_nfd_4d 81 PUBLIC mpp_nfd_2d_ptr, mpp_nfd_3d_ptr, mpp_nfd_4d_ptr 82 !!gm end 83 ! 70 84 PUBLIC ctl_stop, ctl_warn, get_unit, ctl_opn, ctl_nam 71 85 PUBLIC mynode, mppstop, mppsync, mpp_comm_free 72 PUBLIC mpp_ini_north, mpp_lbc_north, mpp_lbc_north_e 86 PUBLIC mpp_ini_north, mpp_lbc_north_e 87 !!gm PUBLIC mpp_ini_north, mpp_lbc_north, mpp_lbc_north_e 88 PUBLIC mpp_lbc_north_icb, mpp_lnk_2d_icb 73 89 PUBLIC mpp_min, mpp_max, mpp_sum, mpp_minloc, mpp_maxloc 74 90 PUBLIC mpp_max_multiple 75 PUBLIC mpp_lnk_3d, mpp_lnk_3d_gather, mpp_lnk_2d, mpp_lnk_2d_e 76 PUBLIC mpp_lnk_2d_9 , mpp_lnk_2d_multiple 77 PUBLIC mpp_lnk_sum_3d, mpp_lnk_sum_2d 91 !!gm PUBLIC mpp_lnk_2d_9 92 !!gm PUBLIC mpp_lnk_sum_3d, mpp_lnk_sum_2d 78 93 PUBLIC mppscatter, mppgather 79 94 PUBLIC mpp_ini_ice, mpp_ini_znl … … 81 96 PUBLIC mppsend, mpprecv ! needed by TAM and ICB routines 82 97 PUBLIC mpp_lnk_bdy_2d, mpp_lnk_bdy_3d 83 PUBLIC mpp_lbc_north_icb, mpp_lnk_2d_icb84 98 PUBLIC mpprank 85 86 TYPE arrayptr87 REAL , DIMENSION (:,:), POINTER :: pt2d88 END TYPE arrayptr89 PUBLIC arrayptr90 99 91 100 !! * Interfaces … … 101 110 INTERFACE mpp_sum 102 111 MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real, & 103 112 & mppsum_realdd, mppsum_a_realdd 104 113 END INTERFACE 105 INTERFACE mpp_lbc_north106 MODULE PROCEDURE mpp_lbc_north_3d, mpp_lbc_north_2d107 END INTERFACE114 !!gm INTERFACE mpp_lbc_north 115 !!gm MODULE PROCEDURE mpp_lbc_north_3d, mpp_lbc_north_2d 116 !!gm END INTERFACE 108 117 INTERFACE mpp_minloc 109 118 MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d … … 112 121 MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d 113 122 END INTERFACE 114 115 123 INTERFACE mpp_max_multiple 116 124 MODULE PROCEDURE mppmax_real_multiple … … 137 145 138 146 ! variables used in case of sea-ice 139 INTEGER, PUBLIC :: ncomm_ice !: communicator made by the processors with sea-ice (public so that it can be freed in limthd)140 INTEGER :: ngrp_iworld ! group ID for the world processors (for rheology)141 INTEGER :: ngrp_ice ! group ID for the ice processors (for rheology)142 INTEGER :: ndim_rank_ice ! number of 'ice' processors143 INTEGER :: n_ice_root ! number (in the comm_ice) of proc 0 in the ice comm147 INTEGER, PUBLIC :: ncomm_ice !: communicator made by the processors with sea-ice (public so that it can be freed in icethd) 148 INTEGER :: ngrp_iworld ! group ID for the world processors (for rheology) 149 INTEGER :: ngrp_ice ! group ID for the ice processors (for rheology) 150 INTEGER :: ndim_rank_ice ! number of 'ice' processors 151 INTEGER :: n_ice_root ! number (in the comm_ice) of proc 0 in the ice comm 144 152 INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: nrank_ice ! dimension ndim_rank_ice 145 153 146 154 ! variables used for zonal integration 147 155 INTEGER, PUBLIC :: ncomm_znl !: communicator made by the processors on the same zonal average 148 LOGICAL, PUBLIC :: l_znl_root ! True on the 'left'most processor on the same row149 INTEGER :: ngrp_znl !group ID for the znl processors150 INTEGER :: ndim_rank_znl !number of processors on the same zonal average156 LOGICAL, PUBLIC :: l_znl_root !: True on the 'left'most processor on the same row 157 INTEGER :: ngrp_znl ! group ID for the znl processors 158 INTEGER :: ndim_rank_znl ! number of processors on the same zonal average 151 159 INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: nrank_znl ! dimension ndim_rank_znl, number of the procs into the same znl domain 152 160 153 161 ! North fold condition in mpp_mpi with jpni > 1 (PUBLIC for TAM) 154 INTEGER, PUBLIC :: ngrp_world ! group ID for the world processors155 INTEGER, PUBLIC :: ngrp_opa ! group ID for the opa processors156 INTEGER, PUBLIC :: ngrp_north ! group ID for the northern processors (to be fold)157 INTEGER, PUBLIC :: ncomm_north ! communicator made by the processors belonging to ngrp_north158 INTEGER, PUBLIC :: ndim_rank_north ! number of 'sea' processor in the northern line (can be /= jpni !)159 INTEGER, PUBLIC :: njmppmax ! value of njmpp for the processors of the northern line160 INTEGER, PUBLIC :: north_root ! number (in the comm_opa) of proc 0 in the northern comm161 INTEGER, DIMENSION(:), ALLOCATABLE, SAVE, PUBLIC :: nrank_north !dimension ndim_rank_north162 INTEGER, PUBLIC :: ngrp_world !: group ID for the world processors 163 INTEGER, PUBLIC :: ngrp_opa !: group ID for the opa processors 164 INTEGER, PUBLIC :: ngrp_north !: group ID for the northern processors (to be fold) 165 INTEGER, PUBLIC :: ncomm_north !: communicator made by the processors belonging to ngrp_north 166 INTEGER, PUBLIC :: ndim_rank_north !: number of 'sea' processor in the northern line (can be /= jpni !) 167 INTEGER, PUBLIC :: njmppmax !: value of njmpp for the processors of the northern line 168 INTEGER, PUBLIC :: north_root !: number (in the comm_opa) of proc 0 in the northern comm 169 INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE, SAVE :: nrank_north !: dimension ndim_rank_north 162 170 163 171 ! Type of send : standard, buffered, immediate 164 CHARACTER(len=1), PUBLIC :: cn_mpi_send !type od mpi send/recieve (S=standard, B=bsend, I=isend)165 LOGICAL , PUBLIC :: l_isend = .FALSE. !isend use indicator (T if cn_mpi_send='I')166 INTEGER , PUBLIC :: nn_buffer !size of the buffer in case of mpi_bsend167 168 REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE :: tampon! buffer in case of bsend169 170 LOGICAL, PUBLIC :: ln_nnogather !namelist control of northfold comms171 LOGICAL, PUBLIC :: l_north_nogather = .FALSE. !internal control of northfold comms172 INTEGER, PUBLIC :: ityp 173 !!---------------------------------------------------------------------- 174 !! NEMO/OPA 3.3 , NEMO Consortium (2010)172 CHARACTER(len=1), PUBLIC :: cn_mpi_send !: type od mpi send/recieve (S=standard, B=bsend, I=isend) 173 LOGICAL , PUBLIC :: l_isend = .FALSE. !: isend use indicator (T if cn_mpi_send='I') 174 INTEGER , PUBLIC :: nn_buffer !: size of the buffer in case of mpi_bsend 175 176 REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE :: tampon ! buffer in case of bsend 177 178 LOGICAL, PUBLIC :: ln_nnogather !: namelist control of northfold comms 179 LOGICAL, PUBLIC :: l_north_nogather = .FALSE. !: internal control of northfold comms 180 181 !!---------------------------------------------------------------------- 182 !! NEMO/OPA 4.0 , NEMO Consortium (2017) 175 183 !! $Id$ 176 184 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 178 186 CONTAINS 179 187 180 181 FUNCTION mynode( ldtxt, ldname, kumnam_ref , kumnam_cfg , kumond , kstop, localComm ) 188 FUNCTION mynode( ldtxt, ldname, kumnam_ref, kumnam_cfg, kumond, kstop, localComm ) 182 189 !!---------------------------------------------------------------------- 183 190 !! *** routine mynode *** … … 204 211 WRITE(ldtxt(ii),*) '~~~~~~ ' ; ii = ii + 1 205 212 ! 206 207 213 REWIND( kumnam_ref ) ! Namelist nammpp in reference namelist: mpi variables 208 214 READ ( kumnam_ref, nammpp, IOSTAT = ios, ERR = 901) 209 215 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammpp in reference namelist', lwp ) 210 216 ! 211 217 REWIND( kumnam_cfg ) ! Namelist nammpp in configuration namelist: mpi variables 212 218 READ ( kumnam_cfg, nammpp, IOSTAT = ios, ERR = 902 ) 213 219 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammpp in configuration namelist', lwp ) 214 220 ! 215 221 ! ! control print 216 222 WRITE(ldtxt(ii),*) ' Namelist nammpp' ; ii = ii + 1 217 223 WRITE(ldtxt(ii),*) ' mpi send type cn_mpi_send = ', cn_mpi_send ; ii = ii + 1 218 224 WRITE(ldtxt(ii),*) ' size exported buffer nn_buffer = ', nn_buffer,' bytes'; ii = ii + 1 219 225 ! 220 226 #if defined key_agrif 221 227 IF( .NOT. Agrif_Root() ) THEN … … 225 231 ENDIF 226 232 #endif 227 228 IF(jpnij < 1)THEN 229 ! If jpnij is not specified in namelist then we calculate it - this 230 ! means there will be no land cutting out. 231 jpnij = jpni * jpnj 232 END IF 233 234 IF( (jpni < 1) .OR. (jpnj < 1) )THEN 233 ! 234 IF( jpnij < 1 ) THEN ! If jpnij is not specified in namelist then we calculate it 235 jpnij = jpni * jpnj ! this means there will be no land cutting out. 236 ENDIF 237 238 IF( jpni < 1 .OR. jpnj < 1 ) THEN 235 239 WRITE(ldtxt(ii),*) ' jpni, jpnj and jpnij will be calculated automatically' ; ii = ii + 1 236 240 ELSE … … 238 242 WRITE(ldtxt(ii),*) ' processor grid extent in j jpnj = ',jpnj ; ii = ii + 1 239 243 WRITE(ldtxt(ii),*) ' number of local domains jpnij = ',jpnij ; ii = ii + 1 240 END 244 ENDIF 241 245 242 246 WRITE(ldtxt(ii),*) ' avoid use of mpi_allgather at the north fold ln_nnogather = ', ln_nnogather ; ii = ii + 1 … … 268 272 kstop = kstop + 1 269 273 END SELECT 270 ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN 274 ! 275 ELSEIF ( PRESENT(localComm) .AND. .NOT. mpi_was_called ) THEN 271 276 WRITE(ldtxt(ii),*) ' lib_mpp: You cannot provide a local communicator ' ; ii = ii + 1 272 277 WRITE(ldtxt(ii),*) ' without calling MPI_Init before ! ' ; ii = ii + 1 … … 309 314 310 315 #if defined key_agrif 311 IF (Agrif_Root()) THEN316 IF( Agrif_Root() ) THEN 312 317 CALL Agrif_MPI_Init(mpi_comm_opa) 313 318 ELSE … … 329 334 END FUNCTION mynode 330 335 331 332 SUBROUTINE mpp_lnk_3d( ptab, cd_type, psgn, cd_mpp, pval ) 333 !!---------------------------------------------------------------------- 334 !! *** routine mpp_lnk_3d *** 335 !! 336 !! ** Purpose : Message passing manadgement 337 !! 338 !! ** Method : Use mppsend and mpprecv function for passing mask 339 !! between processors following neighboring subdomains. 340 !! domain parameters 341 !! nlci : first dimension of the local subdomain 342 !! nlcj : second dimension of the local subdomain 343 !! nbondi : mark for "east-west local boundary" 344 !! nbondj : mark for "north-south local boundary" 345 !! noea : number for local neighboring processors 346 !! nowe : number for local neighboring processors 347 !! noso : number for local neighboring processors 348 !! nono : number for local neighboring processors 349 !! 350 !! ** Action : ptab with update value at its periphery 351 !! 352 !!---------------------------------------------------------------------- 353 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: ptab ! 3D array on which the boundary condition is applied 354 CHARACTER(len=1) , INTENT(in ) :: cd_type ! define the nature of ptab array grid-points 355 ! ! = T , U , V , F , W points 356 REAL(wp) , INTENT(in ) :: psgn ! =-1 the sign change across the north fold boundary 357 ! ! = 1. , the sign is kept 358 CHARACTER(len=3), OPTIONAL , INTENT(in ) :: cd_mpp ! fill the overlap area only 359 REAL(wp) , OPTIONAL , INTENT(in ) :: pval ! background value (used at closed boundaries) 360 ! 361 INTEGER :: ji, jj, jk, jl ! dummy loop indices 362 INTEGER :: imigr, iihom, ijhom ! temporary integers 363 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend 364 REAL(wp) :: zland 365 INTEGER , DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 366 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zt3ns, zt3sn ! 3d for north-south & south-north 367 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zt3ew, zt3we ! 3d for east-west & west-east 368 !!---------------------------------------------------------------------- 369 370 ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2), & 371 & zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2) ) 372 373 ! 374 IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value 375 ELSE ; zland = 0._wp ! zero by default 376 ENDIF 377 378 ! 1. standard boundary treatment 379 ! ------------------------------ 380 IF( PRESENT( cd_mpp ) ) THEN ! only fill added line/raw with existing values 381 ! 382 ! WARNING ptab is defined only between nld and nle 383 DO jk = 1, jpk 384 DO jj = nlcj+1, jpj ! added line(s) (inner only) 385 ptab(nldi :nlei , jj ,jk) = ptab(nldi:nlei, nlej,jk) 386 ptab(1 :nldi-1, jj ,jk) = ptab(nldi , nlej,jk) 387 ptab(nlei+1:nlci , jj ,jk) = ptab( nlei, nlej,jk) 388 END DO 389 DO ji = nlci+1, jpi ! added column(s) (full) 390 ptab(ji ,nldj :nlej ,jk) = ptab( nlei,nldj:nlej,jk) 391 ptab(ji ,1 :nldj-1,jk) = ptab( nlei,nldj ,jk) 392 ptab(ji ,nlej+1:jpj ,jk) = ptab( nlei, nlej,jk) 393 END DO 394 END DO 395 ! 396 ELSE ! standard close or cyclic treatment 397 ! 398 ! ! East-West boundaries 399 ! !* Cyclic east-west 400 IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 401 ptab( 1 ,:,:) = ptab(jpim1,:,:) 402 ptab(jpi,:,:) = ptab( 2 ,:,:) 403 ELSE !* closed 404 IF( .NOT. cd_type == 'F' ) ptab( 1 :jpreci,:,:) = zland ! south except F-point 405 ptab(nlci-jpreci+1:jpi ,:,:) = zland ! north 406 ENDIF 407 ! North-south cyclic 408 IF ( nbondj == 2 .AND. jperio == 7 ) THEN !* cyclic north south only with no mpp split in latitude 409 ptab(:,1 , :) = ptab(:, jpjm1,:) 410 ptab(:,jpj,:) = ptab(:, 2,:) 411 ELSE ! ! North-South boundaries (closed) 412 IF( .NOT. cd_type == 'F' ) ptab(:, 1 :jprecj,:) = zland ! south except F-point 413 ptab(:,nlcj-jprecj+1:jpj ,:) = zland ! north 414 ENDIF 415 ! 416 ENDIF 417 418 ! 2. East and west directions exchange 419 ! ------------------------------------ 420 ! we play with the neigbours AND the row number because of the periodicity 421 ! 422 SELECT CASE ( nbondi ) ! Read Dirichlet lateral conditions 423 CASE ( -1, 0, 1 ) ! all exept 2 (i.e. close case) 424 iihom = nlci-nreci 425 DO jl = 1, jpreci 426 zt3ew(:,jl,:,1) = ptab(jpreci+jl,:,:) 427 zt3we(:,jl,:,1) = ptab(iihom +jl,:,:) 428 END DO 429 END SELECT 430 ! 431 ! ! Migrations 432 imigr = jpreci * jpj * jpk 433 ! 434 SELECT CASE ( nbondi ) 435 CASE ( -1 ) 436 CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 ) 437 CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea ) 438 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 439 CASE ( 0 ) 440 CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 ) 441 CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 ) 442 CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea ) 443 CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe ) 444 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 445 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 446 CASE ( 1 ) 447 CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 ) 448 CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe ) 449 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 450 END SELECT 451 ! 452 ! ! Write Dirichlet lateral conditions 453 iihom = nlci-jpreci 454 ! 455 SELECT CASE ( nbondi ) 456 CASE ( -1 ) 457 DO jl = 1, jpreci 458 ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2) 459 END DO 460 CASE ( 0 ) 461 DO jl = 1, jpreci 462 ptab(jl ,:,:) = zt3we(:,jl,:,2) 463 ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2) 464 END DO 465 CASE ( 1 ) 466 DO jl = 1, jpreci 467 ptab(jl ,:,:) = zt3we(:,jl,:,2) 468 END DO 469 END SELECT 470 471 ! 3. North and south directions 472 ! ----------------------------- 473 ! always closed : we play only with the neigbours 474 ! 475 IF( nbondj /= 2 ) THEN ! Read Dirichlet lateral conditions 476 ijhom = nlcj-nrecj 477 DO jl = 1, jprecj 478 zt3sn(:,jl,:,1) = ptab(:,ijhom +jl,:) 479 zt3ns(:,jl,:,1) = ptab(:,jprecj+jl,:) 480 END DO 481 ENDIF 482 ! 483 ! ! Migrations 484 imigr = jprecj * jpi * jpk 485 ! 486 SELECT CASE ( nbondj ) 487 CASE ( -1 ) 488 CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 ) 489 CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono ) 490 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 491 CASE ( 0 ) 492 CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 493 CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 ) 494 CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono ) 495 CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) 496 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 497 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 498 CASE ( 1 ) 499 CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 ) 500 CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso ) 501 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 502 END SELECT 503 ! 504 ! ! Write Dirichlet lateral conditions 505 ijhom = nlcj-jprecj 506 ! 507 SELECT CASE ( nbondj ) 508 CASE ( -1 ) 509 DO jl = 1, jprecj 510 ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2) 511 END DO 512 CASE ( 0 ) 513 DO jl = 1, jprecj 514 ptab(:,jl ,:) = zt3sn(:,jl,:,2) 515 ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2) 516 END DO 517 CASE ( 1 ) 518 DO jl = 1, jprecj 519 ptab(:,jl,:) = zt3sn(:,jl,:,2) 520 END DO 521 END SELECT 522 523 ! 4. north fold treatment 524 ! ----------------------- 525 ! 526 IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN 527 ! 528 SELECT CASE ( jpni ) 529 CASE ( 1 ) ; CALL lbc_nfd ( ptab, cd_type, psgn ) ! only 1 northern proc, no mpp 530 CASE DEFAULT ; CALL mpp_lbc_north( ptab, cd_type, psgn ) ! for all northern procs. 531 END SELECT 532 ! 533 ENDIF 534 ! 535 DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we ) 536 ! 537 END SUBROUTINE mpp_lnk_3d 538 539 540 SUBROUTINE mpp_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields , cd_mpp, pval ) 541 !!---------------------------------------------------------------------- 542 !! *** routine mpp_lnk_2d_multiple *** 543 !! 544 !! ** Purpose : Message passing management for multiple 2d arrays 545 !! 546 !! ** Method : Use mppsend and mpprecv function for passing mask 547 !! between processors following neighboring subdomains. 548 !! domain parameters 549 !! nlci : first dimension of the local subdomain 550 !! nlcj : second dimension of the local subdomain 551 !! nbondi : mark for "east-west local boundary" 552 !! nbondj : mark for "north-south local boundary" 553 !! noea : number for local neighboring processors 554 !! nowe : number for local neighboring processors 555 !! noso : number for local neighboring processors 556 !! nono : number for local neighboring processors 557 !!---------------------------------------------------------------------- 558 CHARACTER(len=1), DIMENSION(:), INTENT(in ) :: type_array ! define the nature of ptab array grid-points 559 ! ! = T , U , V , F , W and I points 560 REAL(wp) , DIMENSION(:), INTENT(in ) :: psgn_array ! =-1 the sign change across the north fold boundary 561 ! ! = 1. , the sign is kept 562 CHARACTER(len=3), OPTIONAL , INTENT(in ) :: cd_mpp ! fill the overlap area only 563 REAL(wp) , OPTIONAL , INTENT(in ) :: pval ! background value (used at closed boundaries) 564 !! 565 INTEGER :: ji, jj, jl ! dummy loop indices 566 INTEGER :: ii !!MULTI SEND DUMMY LOOP INDICES 567 INTEGER :: imigr, iihom, ijhom ! temporary integers 568 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend 569 INTEGER :: num_fields 570 TYPE( arrayptr ), DIMENSION(:) :: pt2d_array 571 REAL(wp) :: zland 572 INTEGER , DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 573 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ns, zt2sn ! 2d for north-south & south-north 574 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ew, zt2we ! 2d for east-west & west-east 575 576 !!---------------------------------------------------------------------- 577 ! 578 ALLOCATE( zt2ns(jpi,jprecj,2*num_fields), zt2sn(jpi,jprecj,2*num_fields), & 579 & zt2ew(jpj,jpreci,2*num_fields), zt2we(jpj,jpreci,2*num_fields) ) 580 ! 581 IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value 582 ELSE ; zland = 0._wp ! zero by default 583 ENDIF 584 585 ! 1. standard boundary treatment 586 ! ------------------------------ 587 ! 588 !First Array 589 DO ii = 1 , num_fields 590 IF( PRESENT( cd_mpp ) ) THEN ! only fill added line/raw with existing values 591 ! 592 ! WARNING pt2d is defined only between nld and nle 593 DO jj = nlcj+1, jpj ! added line(s) (inner only) 594 pt2d_array(ii)%pt2d(nldi :nlei , jj) = pt2d_array(ii)%pt2d(nldi:nlei, nlej) 595 pt2d_array(ii)%pt2d(1 :nldi-1, jj) = pt2d_array(ii)%pt2d(nldi , nlej) 596 pt2d_array(ii)%pt2d(nlei+1:nlci , jj) = pt2d_array(ii)%pt2d( nlei, nlej) 597 END DO 598 DO ji = nlci+1, jpi ! added column(s) (full) 599 pt2d_array(ii)%pt2d(ji, nldj :nlej ) = pt2d_array(ii)%pt2d(nlei, nldj:nlej) 600 pt2d_array(ii)%pt2d(ji, 1 :nldj-1) = pt2d_array(ii)%pt2d(nlei, nldj ) 601 pt2d_array(ii)%pt2d(ji, nlej+1:jpj ) = pt2d_array(ii)%pt2d(nlei, nlej) 602 END DO 603 ! 604 ELSE ! standard close or cyclic treatment 605 ! 606 ! ! East-West boundaries 607 IF( nbondi == 2 .AND. & ! Cyclic east-west 608 & (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 609 pt2d_array(ii)%pt2d( 1 , : ) = pt2d_array(ii)%pt2d( jpim1, : ) ! west 610 pt2d_array(ii)%pt2d( jpi , : ) = pt2d_array(ii)%pt2d( 2 , : ) ! east 611 ELSE ! closed 612 IF( .NOT. type_array(ii) == 'F' ) pt2d_array(ii)%pt2d( 1 : jpreci,:) = zland ! south except F-point 613 pt2d_array(ii)%pt2d(nlci-jpreci+1 : jpi ,:) = zland ! north 614 ENDIF 615 ! Noth-South boundaries 616 IF ( nbondj == 2 .AND. jperio == 7 ) THEN !* cyclic north south 617 pt2d_array(ii)%pt2d(:, 1 ) = pt2d_array(ii)%pt2d(:, jpjm1 ) 618 pt2d_array(ii)%pt2d(:, jpj ) = pt2d_array(ii)%pt2d(:, 2 ) 619 ELSE ! 620 ! ! North-South boundaries (closed) 621 IF( .NOT. type_array(ii) == 'F' ) pt2d_array(ii)%pt2d(:, 1:jprecj ) = zland ! south except F-point 622 pt2d_array(ii)%pt2d(:, nlcj-jprecj+1:jpj ) = zland ! north 623 ! 624 ENDIF 625 ENDIF 626 END DO 627 628 ! 2. East and west directions exchange 629 ! ------------------------------------ 630 ! we play with the neigbours AND the row number because of the periodicity 631 ! 632 DO ii = 1 , num_fields 633 SELECT CASE ( nbondi ) ! Read Dirichlet lateral conditions 634 CASE ( -1, 0, 1 ) ! all exept 2 (i.e. close case) 635 iihom = nlci-nreci 636 DO jl = 1, jpreci 637 zt2ew( : , jl , ii ) = pt2d_array(ii)%pt2d( jpreci+jl , : ) 638 zt2we( : , jl , ii ) = pt2d_array(ii)%pt2d( iihom +jl , : ) 639 END DO 640 END SELECT 641 END DO 642 ! 643 ! ! Migrations 644 imigr = jpreci * jpj 645 ! 646 SELECT CASE ( nbondi ) 647 CASE ( -1 ) 648 CALL mppsend( 2, zt2we(1,1,1), num_fields*imigr, noea, ml_req1 ) 649 CALL mpprecv( 1, zt2ew(1,1,num_fields+1), num_fields*imigr, noea ) 650 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 651 CASE ( 0 ) 652 CALL mppsend( 1, zt2ew(1,1,1), num_fields*imigr, nowe, ml_req1 ) 653 CALL mppsend( 2, zt2we(1,1,1), num_fields*imigr, noea, ml_req2 ) 654 CALL mpprecv( 1, zt2ew(1,1,num_fields+1), num_fields*imigr, noea ) 655 CALL mpprecv( 2, zt2we(1,1,num_fields+1), num_fields*imigr, nowe ) 656 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 657 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 658 CASE ( 1 ) 659 CALL mppsend( 1, zt2ew(1,1,1), num_fields*imigr, nowe, ml_req1 ) 660 CALL mpprecv( 2, zt2we(1,1,num_fields+1), num_fields*imigr, nowe ) 661 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 662 END SELECT 663 ! 664 ! ! Write Dirichlet lateral conditions 665 iihom = nlci - jpreci 666 ! 667 668 DO ii = 1 , num_fields 669 SELECT CASE ( nbondi ) 670 CASE ( -1 ) 671 DO jl = 1, jpreci 672 pt2d_array(ii)%pt2d( iihom+jl , : ) = zt2ew(:,jl,num_fields+ii) 673 END DO 674 CASE ( 0 ) 675 DO jl = 1, jpreci 676 pt2d_array(ii)%pt2d( jl , : ) = zt2we(:,jl,num_fields+ii) 677 pt2d_array(ii)%pt2d( iihom+jl , : ) = zt2ew(:,jl,num_fields+ii) 678 END DO 679 CASE ( 1 ) 680 DO jl = 1, jpreci 681 pt2d_array(ii)%pt2d( jl , : )= zt2we(:,jl,num_fields+ii) 682 END DO 683 END SELECT 684 END DO 685 686 ! 3. North and south directions 687 ! ----------------------------- 688 ! always closed : we play only with the neigbours 689 ! 690 !First Array 691 DO ii = 1 , num_fields 692 IF( nbondj /= 2 ) THEN ! Read Dirichlet lateral conditions 693 ijhom = nlcj-nrecj 694 DO jl = 1, jprecj 695 zt2sn(:,jl , ii) = pt2d_array(ii)%pt2d( : , ijhom +jl ) 696 zt2ns(:,jl , ii) = pt2d_array(ii)%pt2d( : , jprecj+jl ) 697 END DO 698 ENDIF 699 END DO 700 ! 701 ! ! Migrations 702 imigr = jprecj * jpi 703 ! 704 SELECT CASE ( nbondj ) 705 CASE ( -1 ) 706 CALL mppsend( 4, zt2sn(1,1,1), num_fields*imigr, nono, ml_req1 ) 707 CALL mpprecv( 3, zt2ns(1,1,num_fields+1), num_fields*imigr, nono ) 708 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 709 CASE ( 0 ) 710 CALL mppsend( 3, zt2ns(1,1,1), num_fields*imigr, noso, ml_req1 ) 711 CALL mppsend( 4, zt2sn(1,1,1), num_fields*imigr, nono, ml_req2 ) 712 CALL mpprecv( 3, zt2ns(1,1,num_fields+1), num_fields*imigr, nono ) 713 CALL mpprecv( 4, zt2sn(1,1,num_fields+1), num_fields*imigr, noso ) 714 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 715 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 716 CASE ( 1 ) 717 CALL mppsend( 3, zt2ns(1,1,1), num_fields*imigr, noso, ml_req1 ) 718 CALL mpprecv( 4, zt2sn(1,1,num_fields+1), num_fields*imigr, noso ) 719 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 720 END SELECT 721 ! 722 ! ! Write Dirichlet lateral conditions 723 ijhom = nlcj - jprecj 724 ! 725 726 DO ii = 1 , num_fields 727 !First Array 728 SELECT CASE ( nbondj ) 729 CASE ( -1 ) 730 DO jl = 1, jprecj 731 pt2d_array(ii)%pt2d( : , ijhom+jl ) = zt2ns( : , jl , num_fields+ii ) 732 END DO 733 CASE ( 0 ) 734 DO jl = 1, jprecj 735 pt2d_array(ii)%pt2d( : , jl ) = zt2sn( : , jl , num_fields + ii) 736 pt2d_array(ii)%pt2d( : , ijhom + jl ) = zt2ns( : , jl , num_fields + ii ) 737 END DO 738 CASE ( 1 ) 739 DO jl = 1, jprecj 740 pt2d_array(ii)%pt2d( : , jl ) = zt2sn( : , jl , num_fields + ii ) 741 END DO 742 END SELECT 743 END DO 744 745 ! 4. north fold treatment 746 ! ----------------------- 747 ! 748 !First Array 749 IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN 750 ! 751 SELECT CASE ( jpni ) 752 CASE ( 1 ) ; 753 DO ii = 1 , num_fields 754 CALL lbc_nfd ( pt2d_array(ii)%pt2d( : , : ), type_array(ii) , psgn_array(ii) ) ! only 1 northern proc, no mpp 755 END DO 756 CASE DEFAULT ; CALL mpp_lbc_north_2d_multiple( pt2d_array, type_array, psgn_array, num_fields ) ! for all northern procs. 757 END SELECT 758 ! 759 ENDIF 760 ! 761 ! 762 DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we ) 763 ! 764 END SUBROUTINE mpp_lnk_2d_multiple 765 766 767 SUBROUTINE load_array( pt2d, cd_type, psgn, pt2d_array, type_array, psgn_array, num_fields ) 768 !!--------------------------------------------------------------------- 769 REAL(wp), DIMENSION(jpi,jpj), TARGET, INTENT(inout) :: pt2d ! Second 2D array on which the boundary condition is applied 770 CHARACTER(len=1) , INTENT(in ) :: cd_type ! define the nature of ptab array grid-points 771 REAL(wp) , INTENT(in ) :: psgn ! =-1 the sign change across the north fold boundary 772 TYPE(arrayptr) , DIMENSION(9) :: pt2d_array 773 CHARACTER(len=1) , DIMENSION(9) :: type_array ! define the nature of ptab array grid-points 774 REAL(wp) , DIMENSION(9) :: psgn_array ! =-1 the sign change across the north fold boundary 775 INTEGER , INTENT (inout) :: num_fields 776 !!--------------------------------------------------------------------- 777 num_fields = num_fields + 1 778 pt2d_array(num_fields)%pt2d => pt2d 779 type_array(num_fields) = cd_type 780 psgn_array(num_fields) = psgn 781 END SUBROUTINE load_array 336 !!---------------------------------------------------------------------- 337 !! *** routine mpp_lnk_(2,3,4)d *** 338 !! 339 !! * Argument : dummy argument use in mpp_lnk_... routines 340 !! ptab : array or pointer of arrays on which the boundary condition is applied 341 !! cd_nat : nature of array grid-points 342 !! psgn : sign used across the north fold boundary 343 !! kfld : optional, number of pt3d arrays 344 !! cd_mpp : optional, fill the overlap area only 345 !! pval : optional, background value (used at closed boundaries) 346 !!---------------------------------------------------------------------- 347 ! 348 ! !== 2D array and array of 2D pointer ==! 349 ! 350 # define DIM_2d 351 # define ROUTINE_LNK mpp_lnk_2d 352 # include "mpp_lnk_generic.h90" 353 # undef ROUTINE_LNK 354 # define MULTI 355 # define ROUTINE_LNK mpp_lnk_2d_ptr 356 # include "mpp_lnk_generic.h90" 357 # undef ROUTINE_LNK 358 # undef MULTI 359 # undef DIM_2d 360 ! 361 ! !== 3D array and array of 3D pointer ==! 362 ! 363 # define DIM_3d 364 # define ROUTINE_LNK mpp_lnk_3d 365 # include "mpp_lnk_generic.h90" 366 # undef ROUTINE_LNK 367 # define MULTI 368 # define ROUTINE_LNK mpp_lnk_3d_ptr 369 # include "mpp_lnk_generic.h90" 370 # undef ROUTINE_LNK 371 # undef MULTI 372 # undef DIM_3d 373 ! 374 ! !== 4D array and array of 4D pointer ==! 375 ! 376 # define DIM_4d 377 # define ROUTINE_LNK mpp_lnk_4d 378 # include "mpp_lnk_generic.h90" 379 # undef ROUTINE_LNK 380 # define MULTI 381 # define ROUTINE_LNK mpp_lnk_4d_ptr 382 # include "mpp_lnk_generic.h90" 383 # undef ROUTINE_LNK 384 # undef MULTI 385 # undef DIM_4d 386 387 !!---------------------------------------------------------------------- 388 !! *** routine mpp_nfd_(2,3,4)d *** 389 !! 390 !! * Argument : dummy argument use in mpp_nfd_... routines 391 !! ptab : array or pointer of arrays on which the boundary condition is applied 392 !! cd_nat : nature of array grid-points 393 !! psgn : sign used across the north fold boundary 394 !! kfld : optional, number of pt3d arrays 395 !! cd_mpp : optional, fill the overlap area only 396 !! pval : optional, background value (used at closed boundaries) 397 !!---------------------------------------------------------------------- 398 ! 399 ! !== 2D array and array of 2D pointer ==! 400 ! 401 # define DIM_2d 402 # define ROUTINE_NFD mpp_nfd_2d 403 # include "mpp_nfd_generic.h90" 404 # undef ROUTINE_NFD 405 # define MULTI 406 # define ROUTINE_NFD mpp_nfd_2d_ptr 407 # include "mpp_nfd_generic.h90" 408 # undef ROUTINE_NFD 409 # undef MULTI 410 # undef DIM_2d 411 ! 412 ! !== 3D array and array of 3D pointer ==! 413 ! 414 # define DIM_3d 415 # define ROUTINE_NFD mpp_nfd_3d 416 # include "mpp_nfd_generic.h90" 417 # undef ROUTINE_NFD 418 # define MULTI 419 # define ROUTINE_NFD mpp_nfd_3d_ptr 420 # include "mpp_nfd_generic.h90" 421 # undef ROUTINE_NFD 422 # undef MULTI 423 # undef DIM_3d 424 ! 425 ! !== 4D array and array of 4D pointer ==! 426 ! 427 # define DIM_4d 428 # define ROUTINE_NFD mpp_nfd_4d 429 # include "mpp_nfd_generic.h90" 430 # undef ROUTINE_NFD 431 # define MULTI 432 # define ROUTINE_NFD mpp_nfd_4d_ptr 433 # include "mpp_nfd_generic.h90" 434 # undef ROUTINE_NFD 435 # undef MULTI 436 # undef DIM_4d 437 438 439 !!---------------------------------------------------------------------- 440 !! *** routine mpp_lnk_bdy_(2,3,4)d *** 441 !! 442 !! * Argument : dummy argument use in mpp_lnk_... routines 443 !! ptab : array or pointer of arrays on which the boundary condition is applied 444 !! cd_nat : nature of array grid-points 445 !! psgn : sign used across the north fold boundary 446 !! kb_bdy : BDY boundary set 447 !! kfld : optional, number of pt3d arrays 448 !!---------------------------------------------------------------------- 449 ! 450 ! !== 2D array and array of 2D pointer ==! 451 ! 452 # define DIM_2d 453 # define ROUTINE_BDY mpp_lnk_bdy_2d 454 # include "mpp_bdy_generic.h90" 455 # undef ROUTINE_BDY 456 # define MULTI 457 # define ROUTINE_BDY mpp_lnk_bdy_2d_ptr 458 # include "mpp_bdy_generic.h90" 459 # undef ROUTINE_BDY 460 # undef MULTI 461 # undef DIM_2d 462 ! 463 ! !== 3D array and array of 3D pointer ==! 464 ! 465 # define DIM_3d 466 # define ROUTINE_BDY mpp_lnk_bdy_3d 467 # include "mpp_bdy_generic.h90" 468 # undef ROUTINE_BDY 469 # define MULTI 470 # define ROUTINE_BDY mpp_lnk_bdy_3d_ptr 471 # include "mpp_bdy_generic.h90" 472 # undef ROUTINE_BDY 473 # undef MULTI 474 # undef DIM_3d 475 ! 476 ! !== 4D array and array of 4D pointer ==! 477 ! 478 !!# define DIM_4d 479 !!# define ROUTINE_BDY mpp_lnk_bdy_4d 480 !!# include "mpp_bdy_generic.h90" 481 !!# undef ROUTINE_BDY 482 !!# define MULTI 483 !!# define ROUTINE_BDY mpp_lnk_bdy_4d_ptr 484 !!# include "mpp_bdy_generic.h90" 485 !!# undef ROUTINE_BDY 486 !!# undef MULTI 487 !!# undef DIM_4d 488 489 !!---------------------------------------------------------------------- 490 !! 491 !! load_array & mpp_lnk_2d_9 à generaliser a 3D et 4D 782 492 783 493 784 SUBROUTINE mpp_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC & 785 & , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF & 786 & , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval) 787 !!--------------------------------------------------------------------- 788 ! Second 2D array on which the boundary condition is applied 789 REAL(wp), DIMENSION(jpi,jpj), TARGET , INTENT(inout) :: pt2dA 790 REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) :: pt2dB , pt2dC , pt2dD , pt2dE 791 REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) :: pt2dF , pt2dG , pt2dH , pt2dI 792 ! define the nature of ptab array grid-points 793 CHARACTER(len=1) , INTENT(in ) :: cd_typeA 794 CHARACTER(len=1) , OPTIONAL, INTENT(in ) :: cd_typeB , cd_typeC , cd_typeD , cd_typeE 795 CHARACTER(len=1) , OPTIONAL, INTENT(in ) :: cd_typeF , cd_typeG , cd_typeH , cd_typeI 796 ! =-1 the sign change across the north fold boundary 797 REAL(wp) , INTENT(in ) :: psgnA 798 REAL(wp) , OPTIONAL, INTENT(in ) :: psgnB , psgnC , psgnD , psgnE 799 REAL(wp) , OPTIONAL, INTENT(in ) :: psgnF , psgnG , psgnH , psgnI 800 CHARACTER(len=3) , OPTIONAL, INTENT(in ) :: cd_mpp ! fill the overlap area only 801 REAL(wp) , OPTIONAL, INTENT(in ) :: pval ! background value (used at closed boundaries) 802 !! 803 TYPE(arrayptr) , DIMENSION(9) :: pt2d_array 804 CHARACTER(len=1) , DIMENSION(9) :: type_array ! define the nature of ptab array grid-points 805 ! ! = T , U , V , F , W and I points 806 REAL(wp) , DIMENSION(9) :: psgn_array ! =-1 the sign change across the north fold boundary 807 INTEGER :: num_fields 808 !!--------------------------------------------------------------------- 809 ! 810 num_fields = 0 811 ! 812 ! Load the first array 813 CALL load_array( pt2dA, cd_typeA, psgnA, pt2d_array, type_array, psgn_array, num_fields ) 814 ! 815 ! Look if more arrays are added 816 IF( PRESENT(psgnB) ) CALL load_array(pt2dB,cd_typeB,psgnB,pt2d_array, type_array, psgn_array,num_fields) 817 IF( PRESENT(psgnC) ) CALL load_array(pt2dC,cd_typeC,psgnC,pt2d_array, type_array, psgn_array,num_fields) 818 IF( PRESENT(psgnD) ) CALL load_array(pt2dD,cd_typeD,psgnD,pt2d_array, type_array, psgn_array,num_fields) 819 IF( PRESENT(psgnE) ) CALL load_array(pt2dE,cd_typeE,psgnE,pt2d_array, type_array, psgn_array,num_fields) 820 IF( PRESENT(psgnF) ) CALL load_array(pt2dF,cd_typeF,psgnF,pt2d_array, type_array, psgn_array,num_fields) 821 IF( PRESENT(psgnG) ) CALL load_array(pt2dG,cd_typeG,psgnG,pt2d_array, type_array, psgn_array,num_fields) 822 IF( PRESENT(psgnH) ) CALL load_array(pt2dH,cd_typeH,psgnH,pt2d_array, type_array, psgn_array,num_fields) 823 IF( PRESENT(psgnI) ) CALL load_array(pt2dI,cd_typeI,psgnI,pt2d_array, type_array, psgn_array,num_fields) 824 ! 825 CALL mpp_lnk_2d_multiple( pt2d_array, type_array, psgn_array, num_fields, cd_mpp,pval ) 826 ! 827 END SUBROUTINE mpp_lnk_2d_9 828 829 830 SUBROUTINE mpp_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval ) 831 !!---------------------------------------------------------------------- 832 !! *** routine mpp_lnk_2d *** 833 !! 834 !! ** Purpose : Message passing manadgement for 2d array 835 !! 836 !! ** Method : Use mppsend and mpprecv function for passing mask 837 !! between processors following neighboring subdomains. 838 !! domain parameters 839 !! nlci : first dimension of the local subdomain 840 !! nlcj : second dimension of the local subdomain 841 !! nbondi : mark for "east-west local boundary" 842 !! nbondj : mark for "north-south local boundary" 843 !! noea : number for local neighboring processors 844 !! nowe : number for local neighboring processors 845 !! noso : number for local neighboring processors 846 !! nono : number for local neighboring processors 847 !! 848 !!---------------------------------------------------------------------- 849 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pt2d ! 2D array on which the boundary condition is applied 850 CHARACTER(len=1) , INTENT(in ) :: cd_type ! define the nature of ptab array grid-points 851 ! ! = T , U , V , F , W and I points 852 REAL(wp) , INTENT(in ) :: psgn ! =-1 the sign change across the north fold boundary 853 ! ! = 1. , the sign is kept 854 CHARACTER(len=3), OPTIONAL , INTENT(in ) :: cd_mpp ! fill the overlap area only 855 REAL(wp) , OPTIONAL , INTENT(in ) :: pval ! background value (used at closed boundaries) 856 !! 857 INTEGER :: ji, jj, jl ! dummy loop indices 858 INTEGER :: imigr, iihom, ijhom ! temporary integers 859 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend 860 REAL(wp) :: zland 861 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 862 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ns, zt2sn ! 2d for north-south & south-north 863 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ew, zt2we ! 2d for east-west & west-east 864 !!---------------------------------------------------------------------- 865 ! 866 ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2), & 867 & zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2) ) 868 ! 869 IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value 870 ELSE ; zland = 0._wp ! zero by default 871 ENDIF 872 873 ! 1. standard boundary treatment 874 ! ------------------------------ 875 ! 876 IF( PRESENT( cd_mpp ) ) THEN ! only fill added line/raw with existing values 877 ! 878 ! WARNING pt2d is defined only between nld and nle 879 DO jj = nlcj+1, jpj ! added line(s) (inner only) 880 pt2d(nldi :nlei , jj ) = pt2d(nldi:nlei, nlej) 881 pt2d(1 :nldi-1, jj ) = pt2d(nldi , nlej) 882 pt2d(nlei+1:nlci , jj ) = pt2d( nlei, nlej) 883 END DO 884 DO ji = nlci+1, jpi ! added column(s) (full) 885 pt2d(ji ,nldj :nlej ) = pt2d( nlei,nldj:nlej) 886 pt2d(ji ,1 :nldj-1) = pt2d( nlei,nldj ) 887 pt2d(ji ,nlej+1:jpj ) = pt2d( nlei, nlej) 888 END DO 889 ! 890 ELSE ! standard close or cyclic treatment 891 ! 892 ! ! East-West boundaries 893 IF( nbondi == 2 .AND. & ! Cyclic east-west 894 & (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 895 pt2d( 1 ,:) = pt2d(jpim1,:) ! west 896 pt2d(jpi,:) = pt2d( 2 ,:) ! east 897 ELSE ! closed 898 IF( .NOT. cd_type == 'F' ) pt2d( 1 :jpreci,:) = zland ! south except F-point 899 pt2d(nlci-jpreci+1:jpi ,:) = zland ! north 900 ENDIF 901 ! North-South boudaries 902 IF ( nbondj == 2 .AND. jperio == 7 ) THEN !* cyclic north south 903 pt2d(:, 1 ) = pt2d(:,jpjm1) 904 pt2d(:, jpj) = pt2d(:, 2) 905 ELSE 906 ! ! North-South boundaries (closed) 907 IF( .NOT. cd_type == 'F' ) pt2d(:, 1 :jprecj) = zland !south except F-point 908 pt2d(:,nlcj-jprecj+1:jpj ) = zland ! north 909 ENDIF 910 ENDIF 911 912 ! 2. East and west directions exchange 913 ! ------------------------------------ 914 ! we play with the neigbours AND the row number because of the periodicity 915 ! 916 SELECT CASE ( nbondi ) ! Read Dirichlet lateral conditions 917 CASE ( -1, 0, 1 ) ! all exept 2 (i.e. close case) 918 iihom = nlci-nreci 919 DO jl = 1, jpreci 920 zt2ew(:,jl,1) = pt2d(jpreci+jl,:) 921 zt2we(:,jl,1) = pt2d(iihom +jl,:) 922 END DO 923 END SELECT 924 ! 925 ! ! Migrations 926 imigr = jpreci * jpj 927 ! 928 SELECT CASE ( nbondi ) 929 CASE ( -1 ) 930 CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 ) 931 CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 932 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 933 CASE ( 0 ) 934 CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 935 CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 ) 936 CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea ) 937 CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 938 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 939 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 940 CASE ( 1 ) 941 CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 ) 942 CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe ) 943 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 944 END SELECT 945 ! 946 ! ! Write Dirichlet lateral conditions 947 iihom = nlci - jpreci 948 ! 949 SELECT CASE ( nbondi ) 950 CASE ( -1 ) 951 DO jl = 1, jpreci 952 pt2d(iihom+jl,:) = zt2ew(:,jl,2) 953 END DO 954 CASE ( 0 ) 955 DO jl = 1, jpreci 956 pt2d(jl ,:) = zt2we(:,jl,2) 957 pt2d(iihom+jl,:) = zt2ew(:,jl,2) 958 END DO 959 CASE ( 1 ) 960 DO jl = 1, jpreci 961 pt2d(jl ,:) = zt2we(:,jl,2) 962 END DO 963 END SELECT 964 965 966 ! 3. North and south directions 967 ! ----------------------------- 968 ! always closed : we play only with the neigbours 969 ! 970 IF( nbondj /= 2 ) THEN ! Read Dirichlet lateral conditions 971 ijhom = nlcj-nrecj 972 DO jl = 1, jprecj 973 zt2sn(:,jl,1) = pt2d(:,ijhom +jl) 974 zt2ns(:,jl,1) = pt2d(:,jprecj+jl) 975 END DO 976 ENDIF 977 ! 978 ! ! Migrations 979 imigr = jprecj * jpi 980 ! 981 SELECT CASE ( nbondj ) 982 CASE ( -1 ) 983 CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 ) 984 CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 985 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 986 CASE ( 0 ) 987 CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 988 CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 ) 989 CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono ) 990 CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 991 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 992 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 993 CASE ( 1 ) 994 CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 ) 995 CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso ) 996 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 997 END SELECT 998 ! 999 ! ! Write Dirichlet lateral conditions 1000 ijhom = nlcj - jprecj 1001 ! 1002 SELECT CASE ( nbondj ) 1003 CASE ( -1 ) 1004 DO jl = 1, jprecj 1005 pt2d(:,ijhom+jl) = zt2ns(:,jl,2) 1006 END DO 1007 CASE ( 0 ) 1008 DO jl = 1, jprecj 1009 pt2d(:,jl ) = zt2sn(:,jl,2) 1010 pt2d(:,ijhom+jl) = zt2ns(:,jl,2) 1011 END DO 1012 CASE ( 1 ) 1013 DO jl = 1, jprecj 1014 pt2d(:,jl ) = zt2sn(:,jl,2) 1015 END DO 1016 END SELECT 1017 1018 1019 ! 4. north fold treatment 1020 ! ----------------------- 1021 ! 1022 IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN 1023 ! 1024 SELECT CASE ( jpni ) 1025 CASE ( 1 ) ; CALL lbc_nfd ( pt2d, cd_type, psgn ) ! only 1 northern proc, no mpp 1026 CASE DEFAULT ; CALL mpp_lbc_north( pt2d, cd_type, psgn ) ! for all northern procs. 1027 END SELECT 1028 ! 1029 ENDIF 1030 ! 1031 DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we ) 1032 ! 1033 END SUBROUTINE mpp_lnk_2d 1034 1035 1036 SUBROUTINE mpp_lnk_3d_gather( ptab1, cd_type1, ptab2, cd_type2, psgn ) 1037 !!---------------------------------------------------------------------- 1038 !! *** routine mpp_lnk_3d_gather *** 1039 !! 1040 !! ** Purpose : Message passing manadgement for two 3D arrays 1041 !! 1042 !! ** Method : Use mppsend and mpprecv function for passing mask 1043 !! between processors following neighboring subdomains. 1044 !! domain parameters 1045 !! nlci : first dimension of the local subdomain 1046 !! nlcj : second dimension of the local subdomain 1047 !! nbondi : mark for "east-west local boundary" 1048 !! nbondj : mark for "north-south local boundary" 1049 !! noea : number for local neighboring processors 1050 !! nowe : number for local neighboring processors 1051 !! noso : number for local neighboring processors 1052 !! nono : number for local neighboring processors 1053 !! 1054 !! ** Action : ptab1 and ptab2 with update value at its periphery 1055 !! 1056 !!---------------------------------------------------------------------- 1057 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: ptab1 ! first and second 3D array on which 1058 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: ptab2 ! the boundary condition is applied 1059 CHARACTER(len=1) , INTENT(in ) :: cd_type1 ! nature of ptab1 and ptab2 arrays 1060 CHARACTER(len=1) , INTENT(in ) :: cd_type2 ! i.e. grid-points = T , U , V , F or W points 1061 REAL(wp) , INTENT(in ) :: psgn ! =-1 the sign change across the north fold boundary 1062 !! ! = 1. , the sign is kept 1063 INTEGER :: jl ! dummy loop indices 1064 INTEGER :: imigr, iihom, ijhom ! temporary integers 1065 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend 1066 INTEGER , DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 1067 REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: zt4ns, zt4sn ! 2 x 3d for north-south & south-north 1068 REAL(wp), DIMENSION(:,:,:,:,:), ALLOCATABLE :: zt4ew, zt4we ! 2 x 3d for east-west & west-east 1069 !!---------------------------------------------------------------------- 1070 ! 1071 ALLOCATE( zt4ns(jpi,jprecj,jpk,2,2), zt4sn(jpi,jprecj,jpk,2,2) , & 1072 & zt4ew(jpj,jpreci,jpk,2,2), zt4we(jpj,jpreci,jpk,2,2) ) 1073 ! 1074 ! 1. standard boundary treatment 1075 ! ------------------------------ 1076 ! ! East-West boundaries 1077 ! !* Cyclic east-west 1078 IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 1079 ptab1( 1 ,:,:) = ptab1(jpim1,:,:) 1080 ptab1(jpi,:,:) = ptab1( 2 ,:,:) 1081 ptab2( 1 ,:,:) = ptab2(jpim1,:,:) 1082 ptab2(jpi,:,:) = ptab2( 2 ,:,:) 1083 ELSE !* closed 1084 IF( .NOT. cd_type1 == 'F' ) ptab1( 1 :jpreci,:,:) = 0.e0 ! south except at F-point 1085 IF( .NOT. cd_type2 == 'F' ) ptab2( 1 :jpreci,:,:) = 0.e0 1086 ptab1(nlci-jpreci+1:jpi ,:,:) = 0.e0 ! north 1087 ptab2(nlci-jpreci+1:jpi ,:,:) = 0.e0 1088 ENDIF 1089 ! North-South boundaries 1090 IF ( nbondj == 2 .AND. jperio == 7 ) THEN !* cyclic north south 1091 ptab1(:, 1 ,:) = ptab1(: , jpjm1 , :) 1092 ptab1(:, jpj ,:) = ptab1(: , 2 , :) 1093 ptab2(:, 1 ,:) = ptab2(: , jpjm1 , :) 1094 ptab2(:, jpj ,:) = ptab2(: , 2 , :) 1095 ELSE 1096 ! ! North-South boundaries closed 1097 IF( .NOT. cd_type1 == 'F' ) ptab1(:, 1 :jprecj,:) = 0.e0 ! south except at F-point 1098 IF( .NOT. cd_type2 == 'F' ) ptab2(:, 1 :jprecj,:) = 0.e0 1099 ptab1(:,nlcj-jprecj+1:jpj ,:) = 0.e0 ! north 1100 ptab2(:,nlcj-jprecj+1:jpj ,:) = 0.e0 1101 ENDIF 1102 1103 ! 2. East and west directions exchange 1104 ! ------------------------------------ 1105 ! we play with the neigbours AND the row number because of the periodicity 1106 ! 1107 SELECT CASE ( nbondi ) ! Read Dirichlet lateral conditions 1108 CASE ( -1, 0, 1 ) ! all exept 2 (i.e. close case) 1109 iihom = nlci-nreci 1110 DO jl = 1, jpreci 1111 zt4ew(:,jl,:,1,1) = ptab1(jpreci+jl,:,:) 1112 zt4we(:,jl,:,1,1) = ptab1(iihom +jl,:,:) 1113 zt4ew(:,jl,:,2,1) = ptab2(jpreci+jl,:,:) 1114 zt4we(:,jl,:,2,1) = ptab2(iihom +jl,:,:) 1115 END DO 1116 END SELECT 1117 ! 1118 ! ! Migrations 1119 imigr = jpreci * jpj * jpk *2 1120 ! 1121 SELECT CASE ( nbondi ) 1122 CASE ( -1 ) 1123 CALL mppsend( 2, zt4we(1,1,1,1,1), imigr, noea, ml_req1 ) 1124 CALL mpprecv( 1, zt4ew(1,1,1,1,2), imigr, noea ) 1125 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 1126 CASE ( 0 ) 1127 CALL mppsend( 1, zt4ew(1,1,1,1,1), imigr, nowe, ml_req1 ) 1128 CALL mppsend( 2, zt4we(1,1,1,1,1), imigr, noea, ml_req2 ) 1129 CALL mpprecv( 1, zt4ew(1,1,1,1,2), imigr, noea ) 1130 CALL mpprecv( 2, zt4we(1,1,1,1,2), imigr, nowe ) 1131 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 1132 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 1133 CASE ( 1 ) 1134 CALL mppsend( 1, zt4ew(1,1,1,1,1), imigr, nowe, ml_req1 ) 1135 CALL mpprecv( 2, zt4we(1,1,1,1,2), imigr, nowe ) 1136 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 1137 END SELECT 1138 ! 1139 ! ! Write Dirichlet lateral conditions 1140 iihom = nlci - jpreci 1141 ! 1142 SELECT CASE ( nbondi ) 1143 CASE ( -1 ) 1144 DO jl = 1, jpreci 1145 ptab1(iihom+jl,:,:) = zt4ew(:,jl,:,1,2) 1146 ptab2(iihom+jl,:,:) = zt4ew(:,jl,:,2,2) 1147 END DO 1148 CASE ( 0 ) 1149 DO jl = 1, jpreci 1150 ptab1(jl ,:,:) = zt4we(:,jl,:,1,2) 1151 ptab1(iihom+jl,:,:) = zt4ew(:,jl,:,1,2) 1152 ptab2(jl ,:,:) = zt4we(:,jl,:,2,2) 1153 ptab2(iihom+jl,:,:) = zt4ew(:,jl,:,2,2) 1154 END DO 1155 CASE ( 1 ) 1156 DO jl = 1, jpreci 1157 ptab1(jl ,:,:) = zt4we(:,jl,:,1,2) 1158 ptab2(jl ,:,:) = zt4we(:,jl,:,2,2) 1159 END DO 1160 END SELECT 1161 1162 1163 ! 3. North and south directions 1164 ! ----------------------------- 1165 ! always closed : we play only with the neigbours 1166 ! 1167 IF( nbondj /= 2 ) THEN ! Read Dirichlet lateral conditions 1168 ijhom = nlcj - nrecj 1169 DO jl = 1, jprecj 1170 zt4sn(:,jl,:,1,1) = ptab1(:,ijhom +jl,:) 1171 zt4ns(:,jl,:,1,1) = ptab1(:,jprecj+jl,:) 1172 zt4sn(:,jl,:,2,1) = ptab2(:,ijhom +jl,:) 1173 zt4ns(:,jl,:,2,1) = ptab2(:,jprecj+jl,:) 1174 END DO 1175 ENDIF 1176 ! 1177 ! ! Migrations 1178 imigr = jprecj * jpi * jpk * 2 1179 ! 1180 SELECT CASE ( nbondj ) 1181 CASE ( -1 ) 1182 CALL mppsend( 4, zt4sn(1,1,1,1,1), imigr, nono, ml_req1 ) 1183 CALL mpprecv( 3, zt4ns(1,1,1,1,2), imigr, nono ) 1184 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 1185 CASE ( 0 ) 1186 CALL mppsend( 3, zt4ns(1,1,1,1,1), imigr, noso, ml_req1 ) 1187 CALL mppsend( 4, zt4sn(1,1,1,1,1), imigr, nono, ml_req2 ) 1188 CALL mpprecv( 3, zt4ns(1,1,1,1,2), imigr, nono ) 1189 CALL mpprecv( 4, zt4sn(1,1,1,1,2), imigr, noso ) 1190 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 1191 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 1192 CASE ( 1 ) 1193 CALL mppsend( 3, zt4ns(1,1,1,1,1), imigr, noso, ml_req1 ) 1194 CALL mpprecv( 4, zt4sn(1,1,1,1,2), imigr, noso ) 1195 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 1196 END SELECT 1197 ! 1198 ! ! Write Dirichlet lateral conditions 1199 ijhom = nlcj - jprecj 1200 ! 1201 SELECT CASE ( nbondj ) 1202 CASE ( -1 ) 1203 DO jl = 1, jprecj 1204 ptab1(:,ijhom+jl,:) = zt4ns(:,jl,:,1,2) 1205 ptab2(:,ijhom+jl,:) = zt4ns(:,jl,:,2,2) 1206 END DO 1207 CASE ( 0 ) 1208 DO jl = 1, jprecj 1209 ptab1(:,jl ,:) = zt4sn(:,jl,:,1,2) 1210 ptab1(:,ijhom+jl,:) = zt4ns(:,jl,:,1,2) 1211 ptab2(:,jl ,:) = zt4sn(:,jl,:,2,2) 1212 ptab2(:,ijhom+jl,:) = zt4ns(:,jl,:,2,2) 1213 END DO 1214 CASE ( 1 ) 1215 DO jl = 1, jprecj 1216 ptab1(:,jl,:) = zt4sn(:,jl,:,1,2) 1217 ptab2(:,jl,:) = zt4sn(:,jl,:,2,2) 1218 END DO 1219 END SELECT 1220 1221 1222 ! 4. north fold treatment 1223 ! ----------------------- 1224 IF( npolj /= 0 ) THEN 1225 ! 1226 SELECT CASE ( jpni ) 1227 CASE ( 1 ) 1228 CALL lbc_nfd ( ptab1, cd_type1, psgn ) ! only for northern procs. 1229 CALL lbc_nfd ( ptab2, cd_type2, psgn ) 1230 CASE DEFAULT 1231 CALL mpp_lbc_north( ptab1, cd_type1, psgn ) ! for all northern procs. 1232 CALL mpp_lbc_north (ptab2, cd_type2, psgn) 1233 END SELECT 1234 ! 1235 ENDIF 1236 ! 1237 DEALLOCATE( zt4ns, zt4sn, zt4ew, zt4we ) 1238 ! 1239 END SUBROUTINE mpp_lnk_3d_gather 494 !! mpp_lnk_2d_e utilisé dans ICB 495 496 497 !! mpp_lnk_sum_2d et 3D ====>>>>>> à virer du code !!!! 498 499 500 !!---------------------------------------------------------------------- 1240 501 1241 502 … … 1284 545 1285 546 1286 ! 1. standard boundary treatment 547 ! 1. standard boundary treatment (CAUTION: the order matters Here !!!! ) 1287 548 ! ------------------------------ 1288 ! Order matters Here !!!! 1289 ! 1290 ! North-South cyclic 1291 IF ( nbondj == 2 .AND. jperio == 7 ) THEN !* cyclic north south 1292 pt2d(:, 1-jprj: 1 ) = pt2d ( :, jpjm1-jprj:jpjm1) 549 ! !== North-South boundaries 550 ! !* cyclic 551 IF( nbondj == 2 .AND. jperio == 7 ) THEN 552 pt2d(:, 1-jprj: 1 ) = pt2d ( :, jpjm1-jprj:jpjm1 ) 1293 553 pt2d(:, jpj :jpj+jprj) = pt2d ( :, 2 :2+jprj) 1294 ELSE 1295 1296 ! !* North-South boundaries (closed) 1297 IF( .NOT. cd_type == 'F' ) pt2d(:, 1-jprj : jprecj ) = 0.e0 ! south except at F-point 1298 pt2d(:,nlcj-jprecj+1:jpj+jprj) = 0.e0 ! north 1299 ENDIF 1300 1301 ! ! East-West boundaries 1302 ! !* Cyclic east-west 554 ELSE !* closed 555 IF( .NOT. cd_type == 'F' ) pt2d(:, 1-jprj : jprecj ) = 0._wp ! south except at F-point 556 pt2d(:,nlcj-jprecj+1:jpj+jprj) = 0._wp ! north 557 ENDIF 558 ! !== East-West boundaries 559 ! !* Cyclic east-west 1303 560 IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 1304 pt2d(1-jpri: 1 ,:) = pt2d(jpim1-jpri: jpim1 ,:) ! east 1305 pt2d( jpi :jpi+jpri,:) = pt2d( 2 :2+jpri,:) ! west 1306 ! 1307 ELSE !* closed 1308 IF( .NOT. cd_type == 'F' ) pt2d( 1-jpri :jpreci ,:) = 0.e0 ! south except at F-point 1309 pt2d(nlci-jpreci+1:jpi+jpri,:) = 0.e0 ! north 1310 ENDIF 1311 ! 1312 561 pt2d(1-jpri: 1 ,:) = pt2d(jpim1-jpri: jpim1 ,:) ! east 562 pt2d( jpi :jpi+jpri,:) = pt2d( 2 :2+jpri,:) ! west 563 ELSE !* closed 564 IF( .NOT. cd_type == 'F' ) pt2d( 1-jpri :jpreci ,:) = 0._wp ! south except at F-point 565 pt2d(nlci-jpreci+1:jpi+jpri,:) = 0._wp ! north 566 ENDIF 567 ! 1313 568 ! north fold treatment 1314 ! -------------------- ---569 ! -------------------- 1315 570 IF( npolj /= 0 ) THEN 1316 571 ! 1317 572 SELECT CASE ( jpni ) 1318 1319 CASE DEFAULT ; CALL mpp_lbc_north_e( pt2d , cd_type, psgn)573 !!gm ERROR CASE ( 1 ) ; CALL lbc_nfd ( pt2d(1:jpi,1:jpj+jprj), cd_type, psgn, pr2dj=jprj ) 574 !!gm ERROR CASE DEFAULT ; CALL mpp_lbc_north_e( pt2d , cd_type, psgn ) 1320 575 END SELECT 1321 576 ! … … 1375 630 END SELECT 1376 631 1377 1378 632 ! 3. North and south directions 1379 633 ! ----------------------------- … … 1430 684 END SUBROUTINE mpp_lnk_2d_e 1431 685 1432 SUBROUTINE mpp_lnk_sum_3d( ptab, cd_type, psgn, cd_mpp, pval )1433 !!----------------------------------------------------------------------1434 !! *** routine mpp_lnk_sum_3d ***1435 !!1436 !! ** Purpose : Message passing manadgement (sum the overlap region)1437 !!1438 !! ** Method : Use mppsend and mpprecv function for passing mask1439 !! between processors following neighboring subdomains.1440 !! domain parameters1441 !! nlci : first dimension of the local subdomain1442 !! nlcj : second dimension of the local subdomain1443 !! nbondi : mark for "east-west local boundary"1444 !! nbondj : mark for "north-south local boundary"1445 !! noea : number for local neighboring processors1446 !! nowe : number for local neighboring processors1447 !! noso : number for local neighboring processors1448 !! nono : number for local neighboring processors1449 !!1450 !! ** Action : ptab with update value at its periphery1451 !!1452 !!----------------------------------------------------------------------1453 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: ptab ! 3D array on which the boundary condition is applied1454 CHARACTER(len=1) , INTENT(in ) :: cd_type ! define the nature of ptab array grid-points1455 ! ! = T , U , V , F , W points1456 REAL(wp) , INTENT(in ) :: psgn ! =-1 the sign change across the north fold boundary1457 ! ! = 1. , the sign is kept1458 CHARACTER(len=3), OPTIONAL , INTENT(in ) :: cd_mpp ! fill the overlap area only1459 REAL(wp) , OPTIONAL , INTENT(in ) :: pval ! background value (used at closed boundaries)1460 !!1461 INTEGER :: ji, jj, jk, jl ! dummy loop indices1462 INTEGER :: imigr, iihom, ijhom ! temporary integers1463 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend1464 REAL(wp) :: zland1465 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend1466 !1467 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zt3ns, zt3sn ! 3d for north-south & south-north1468 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zt3ew, zt3we ! 3d for east-west & west-east1469 1470 !!----------------------------------------------------------------------1471 1472 ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2), &1473 & zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2) )1474 1475 !1476 IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value1477 ELSE ; zland = 0.e0 ! zero by default1478 ENDIF1479 1480 ! 1. standard boundary treatment1481 ! ------------------------------1482 ! 2. East and west directions exchange1483 ! ------------------------------------1484 ! we play with the neigbours AND the row number because of the periodicity1485 !1486 SELECT CASE ( nbondi ) ! Read lateral conditions1487 CASE ( -1, 0, 1 ) ! all exept 2 (i.e. close case)1488 iihom = nlci-jpreci1489 DO jl = 1, jpreci1490 zt3ew(:,jl,:,1) = ptab(jl ,:,:) ; ptab(jl ,:,:) = 0.0_wp1491 zt3we(:,jl,:,1) = ptab(iihom+jl,:,:) ; ptab(iihom+jl,:,:) = 0.0_wp1492 END DO1493 END SELECT1494 !1495 ! ! Migrations1496 imigr = jpreci * jpj * jpk1497 !1498 SELECT CASE ( nbondi )1499 CASE ( -1 )1500 CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 )1501 CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )1502 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)1503 CASE ( 0 )1504 CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )1505 CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 )1506 CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )1507 CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )1508 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)1509 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)1510 CASE ( 1 )1511 CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )1512 CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )1513 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)1514 END SELECT1515 !1516 ! ! Write lateral conditions1517 iihom = nlci-nreci1518 !1519 SELECT CASE ( nbondi )1520 CASE ( -1 )1521 DO jl = 1, jpreci1522 ptab(iihom+jl,:,:) = ptab(iihom+jl,:,:) + zt3ew(:,jl,:,2)1523 END DO1524 CASE ( 0 )1525 DO jl = 1, jpreci1526 ptab(jpreci+jl,:,:) = ptab(jpreci+jl,:,:) + zt3we(:,jl,:,2)1527 ptab(iihom +jl,:,:) = ptab(iihom +jl,:,:) + zt3ew(:,jl,:,2)1528 END DO1529 CASE ( 1 )1530 DO jl = 1, jpreci1531 ptab(jpreci+jl,:,:) = ptab(jpreci+jl,:,:) + zt3we(:,jl,:,2)1532 END DO1533 END SELECT1534 1535 1536 ! 3. North and south directions1537 ! -----------------------------1538 ! always closed : we play only with the neigbours1539 !1540 IF( nbondj /= 2 ) THEN ! Read lateral conditions1541 ijhom = nlcj-jprecj1542 DO jl = 1, jprecj1543 zt3sn(:,jl,:,1) = ptab(:,ijhom+jl,:) ; ptab(:,ijhom+jl,:) = 0.0_wp1544 zt3ns(:,jl,:,1) = ptab(:,jl ,:) ; ptab(:,jl ,:) = 0.0_wp1545 END DO1546 ENDIF1547 !1548 ! ! Migrations1549 imigr = jprecj * jpi * jpk1550 !1551 SELECT CASE ( nbondj )1552 CASE ( -1 )1553 CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 )1554 CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )1555 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)1556 CASE ( 0 )1557 CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )1558 CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 )1559 CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )1560 CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )1561 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)1562 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)1563 CASE ( 1 )1564 CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )1565 CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )1566 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)1567 END SELECT1568 !1569 ! ! Write lateral conditions1570 ijhom = nlcj-nrecj1571 !1572 SELECT CASE ( nbondj )1573 CASE ( -1 )1574 DO jl = 1, jprecj1575 ptab(:,ijhom+jl,:) = ptab(:,ijhom+jl,:) + zt3ns(:,jl,:,2)1576 END DO1577 CASE ( 0 )1578 DO jl = 1, jprecj1579 ptab(:,jprecj+jl,:) = ptab(:,jprecj+jl,:) + zt3sn(:,jl,:,2)1580 ptab(:,ijhom +jl,:) = ptab(:,ijhom +jl,:) + zt3ns(:,jl,:,2)1581 END DO1582 CASE ( 1 )1583 DO jl = 1, jprecj1584 ptab(:,jprecj+jl,:) = ptab(:,jprecj+jl,:) + zt3sn(:,jl ,:,2)1585 END DO1586 END SELECT1587 1588 1589 ! 4. north fold treatment1590 ! -----------------------1591 !1592 IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN1593 !1594 SELECT CASE ( jpni )1595 CASE ( 1 ) ; CALL lbc_nfd ( ptab, cd_type, psgn ) ! only 1 northern proc, no mpp1596 CASE DEFAULT ; CALL mpp_lbc_north( ptab, cd_type, psgn ) ! for all northern procs.1597 END SELECT1598 !1599 ENDIF1600 !1601 DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we )1602 !1603 END SUBROUTINE mpp_lnk_sum_3d1604 1605 SUBROUTINE mpp_lnk_sum_2d( pt2d, cd_type, psgn, cd_mpp, pval )1606 !!----------------------------------------------------------------------1607 !! *** routine mpp_lnk_sum_2d ***1608 !!1609 !! ** Purpose : Message passing manadgement for 2d array (sum the overlap region)1610 !!1611 !! ** Method : Use mppsend and mpprecv function for passing mask1612 !! between processors following neighboring subdomains.1613 !! domain parameters1614 !! nlci : first dimension of the local subdomain1615 !! nlcj : second dimension of the local subdomain1616 !! nbondi : mark for "east-west local boundary"1617 !! nbondj : mark for "north-south local boundary"1618 !! noea : number for local neighboring processors1619 !! nowe : number for local neighboring processors1620 !! noso : number for local neighboring processors1621 !! nono : number for local neighboring processors1622 !!1623 !!----------------------------------------------------------------------1624 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pt2d ! 2D array on which the boundary condition is applied1625 CHARACTER(len=1) , INTENT(in ) :: cd_type ! define the nature of ptab array grid-points1626 ! ! = T , U , V , F , W and I points1627 REAL(wp) , INTENT(in ) :: psgn ! =-1 the sign change across the north fold boundary1628 ! ! = 1. , the sign is kept1629 CHARACTER(len=3), OPTIONAL , INTENT(in ) :: cd_mpp ! fill the overlap area only1630 REAL(wp) , OPTIONAL , INTENT(in ) :: pval ! background value (used at closed boundaries)1631 !!1632 INTEGER :: ji, jj, jl ! dummy loop indices1633 INTEGER :: imigr, iihom, ijhom ! temporary integers1634 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend1635 REAL(wp) :: zland1636 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend1637 !1638 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ns, zt2sn ! 2d for north-south & south-north1639 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ew, zt2we ! 2d for east-west & west-east1640 1641 !!----------------------------------------------------------------------1642 1643 ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2), &1644 & zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2) )1645 1646 !1647 IF( PRESENT( pval ) ) THEN ; zland = pval ! set land value1648 ELSE ; zland = 0.e0 ! zero by default1649 ENDIF1650 1651 ! 1. standard boundary treatment1652 ! ------------------------------1653 ! 2. East and west directions exchange1654 ! ------------------------------------1655 ! we play with the neigbours AND the row number because of the periodicity1656 !1657 SELECT CASE ( nbondi ) ! Read lateral conditions1658 CASE ( -1, 0, 1 ) ! all exept 2 (i.e. close case)1659 iihom = nlci - jpreci1660 DO jl = 1, jpreci1661 zt2ew(:,jl,1) = pt2d(jl ,:) ; pt2d(jl ,:) = 0.0_wp1662 zt2we(:,jl,1) = pt2d(iihom +jl,:) ; pt2d(iihom +jl,:) = 0.0_wp1663 END DO1664 END SELECT1665 !1666 ! ! Migrations1667 imigr = jpreci * jpj1668 !1669 SELECT CASE ( nbondi )1670 CASE ( -1 )1671 CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 )1672 CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )1673 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)1674 CASE ( 0 )1675 CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )1676 CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 )1677 CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )1678 CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )1679 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)1680 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)1681 CASE ( 1 )1682 CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )1683 CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )1684 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)1685 END SELECT1686 !1687 ! ! Write lateral conditions1688 iihom = nlci-nreci1689 !1690 SELECT CASE ( nbondi )1691 CASE ( -1 )1692 DO jl = 1, jpreci1693 pt2d(iihom+jl,:) = pt2d(iihom+jl,:) + zt2ew(:,jl,2)1694 END DO1695 CASE ( 0 )1696 DO jl = 1, jpreci1697 pt2d(jpreci+jl,:) = pt2d(jpreci+jl,:) + zt2we(:,jl,2)1698 pt2d(iihom +jl,:) = pt2d(iihom +jl,:) + zt2ew(:,jl,2)1699 END DO1700 CASE ( 1 )1701 DO jl = 1, jpreci1702 pt2d(jpreci+jl,:) = pt2d(jpreci+jl,:) + zt2we(:,jl,2)1703 END DO1704 END SELECT1705 1706 1707 ! 3. North and south directions1708 ! -----------------------------1709 ! always closed : we play only with the neigbours1710 !1711 IF( nbondj /= 2 ) THEN ! Read lateral conditions1712 ijhom = nlcj - jprecj1713 DO jl = 1, jprecj1714 zt2sn(:,jl,1) = pt2d(:,ijhom +jl) ; pt2d(:,ijhom +jl) = 0.0_wp1715 zt2ns(:,jl,1) = pt2d(:,jl ) ; pt2d(:,jl ) = 0.0_wp1716 END DO1717 ENDIF1718 !1719 ! ! Migrations1720 imigr = jprecj * jpi1721 !1722 SELECT CASE ( nbondj )1723 CASE ( -1 )1724 CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 )1725 CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )1726 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)1727 CASE ( 0 )1728 CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )1729 CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 )1730 CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )1731 CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )1732 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)1733 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)1734 CASE ( 1 )1735 CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )1736 CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )1737 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)1738 END SELECT1739 !1740 ! ! Write lateral conditions1741 ijhom = nlcj-nrecj1742 !1743 SELECT CASE ( nbondj )1744 CASE ( -1 )1745 DO jl = 1, jprecj1746 pt2d(:,ijhom+jl) = pt2d(:,ijhom+jl) + zt2ns(:,jl,2)1747 END DO1748 CASE ( 0 )1749 DO jl = 1, jprecj1750 pt2d(:,jprecj+jl) = pt2d(:,jprecj+jl) + zt2sn(:,jl,2)1751 pt2d(:,ijhom +jl) = pt2d(:,ijhom +jl) + zt2ns(:,jl,2)1752 END DO1753 CASE ( 1 )1754 DO jl = 1, jprecj1755 pt2d(:,jprecj+jl) = pt2d(:,jprecj+jl) + zt2sn(:,jl,2)1756 END DO1757 END SELECT1758 1759 1760 ! 4. north fold treatment1761 ! -----------------------1762 !1763 IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN1764 !1765 SELECT CASE ( jpni )1766 CASE ( 1 ) ; CALL lbc_nfd ( pt2d, cd_type, psgn ) ! only 1 northern proc, no mpp1767 CASE DEFAULT ; CALL mpp_lbc_north( pt2d, cd_type, psgn ) ! for all northern procs.1768 END SELECT1769 !1770 ENDIF1771 !1772 DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we )1773 !1774 END SUBROUTINE mpp_lnk_sum_2d1775 686 1776 687 SUBROUTINE mppsend( ktyp, pmess, kbytes, kdest, md_req ) … … 1874 785 END SUBROUTINE mppscatter 1875 786 1876 787 !!---------------------------------------------------------------------- 788 !! *** mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real *** 789 !! 790 !!---------------------------------------------------------------------- 791 !! 1877 792 SUBROUTINE mppmax_a_int( ktab, kdim, kcom ) 1878 !!----------------------------------------------------------------------1879 !! *** routine mppmax_a_int ***1880 !!1881 !! ** Purpose : Find maximum value in an integer layout array1882 !!1883 793 !!---------------------------------------------------------------------- 1884 794 INTEGER , INTENT(in ) :: kdim ! size of array 1885 795 INTEGER , INTENT(inout), DIMENSION(kdim) :: ktab ! input array 1886 796 INTEGER , INTENT(in ), OPTIONAL :: kcom ! 1887 ! 1888 INTEGER :: ierror, localcomm ! temporary integer 797 INTEGER :: ierror, ilocalcomm ! temporary integer 1889 798 INTEGER, DIMENSION(kdim) :: iwork 1890 799 !!---------------------------------------------------------------------- 1891 ! 1892 localcomm = mpi_comm_opa 1893 IF( PRESENT(kcom) ) localcomm = kcom 1894 ! 1895 CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_max, localcomm, ierror ) 1896 ! 800 ilocalcomm = mpi_comm_opa 801 IF( PRESENT(kcom) ) ilocalcomm = kcom 802 CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_max, ilocalcomm, ierror ) 1897 803 ktab(:) = iwork(:) 1898 !1899 804 END SUBROUTINE mppmax_a_int 1900 1901 805 !! 1902 806 SUBROUTINE mppmax_int( ktab, kcom ) 1903 !!----------------------------------------------------------------------1904 !! *** routine mppmax_int ***1905 !!1906 !! ** Purpose : Find maximum value in an integer layout array1907 !!1908 807 !!---------------------------------------------------------------------- 1909 808 INTEGER, INTENT(inout) :: ktab ! ??? 1910 809 INTEGER, INTENT(in ), OPTIONAL :: kcom ! ??? 1911 ! 1912 INTEGER :: ierror, iwork, localcomm ! temporary integer 1913 !!---------------------------------------------------------------------- 1914 ! 1915 localcomm = mpi_comm_opa 1916 IF( PRESENT(kcom) ) localcomm = kcom 1917 ! 1918 CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_max, localcomm, ierror ) 1919 ! 810 INTEGER :: ierror, iwork, ilocalcomm ! temporary integer 811 !!---------------------------------------------------------------------- 812 ilocalcomm = mpi_comm_opa 813 IF( PRESENT(kcom) ) ilocalcomm = kcom 814 CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_max, ilocalcomm, ierror ) 1920 815 ktab = iwork 1921 !1922 816 END SUBROUTINE mppmax_int 1923 1924 817 !! 818 SUBROUTINE mppmax_a_real( ptab, kdim, kcom ) 819 !!---------------------------------------------------------------------- 820 REAL(wp), DIMENSION(kdim), INTENT(inout) :: ptab 821 INTEGER , INTENT(in ) :: kdim 822 INTEGER , OPTIONAL , INTENT(in ) :: kcom 823 INTEGER :: ierror, ilocalcomm 824 REAL(wp), DIMENSION(kdim) :: zwork 825 !!---------------------------------------------------------------------- 826 ilocalcomm = mpi_comm_opa 827 IF( PRESENT(kcom) ) ilocalcomm = kcom 828 CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_max, ilocalcomm, ierror ) 829 ptab(:) = zwork(:) 830 END SUBROUTINE mppmax_a_real 831 !! 832 SUBROUTINE mppmax_real( ptab, kcom ) 833 !!---------------------------------------------------------------------- 834 REAL(wp), INTENT(inout) :: ptab ! ??? 835 INTEGER , INTENT(in ), OPTIONAL :: kcom ! ??? 836 INTEGER :: ierror, ilocalcomm 837 REAL(wp) :: zwork 838 !!---------------------------------------------------------------------- 839 ilocalcomm = mpi_comm_opa 840 IF( PRESENT(kcom) ) ilocalcomm = kcom! 841 CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_max, ilocalcomm, ierror ) 842 ptab = zwork 843 END SUBROUTINE mppmax_real 844 845 846 !!---------------------------------------------------------------------- 847 !! *** mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real *** 848 !! 849 !!---------------------------------------------------------------------- 850 !! 1925 851 SUBROUTINE mppmin_a_int( ktab, kdim, kcom ) 1926 !!----------------------------------------------------------------------1927 !! *** routine mppmin_a_int ***1928 !!1929 !! ** Purpose : Find minimum value in an integer layout array1930 !!1931 852 !!---------------------------------------------------------------------- 1932 853 INTEGER , INTENT( in ) :: kdim ! size of array … … 1934 855 INTEGER , INTENT( in ), OPTIONAL :: kcom ! input array 1935 856 !! 1936 INTEGER :: ierror, localcomm ! temporary integer857 INTEGER :: ierror, ilocalcomm ! temporary integer 1937 858 INTEGER, DIMENSION(kdim) :: iwork 1938 859 !!---------------------------------------------------------------------- 1939 ! 1940 localcomm = mpi_comm_opa 1941 IF( PRESENT(kcom) ) localcomm = kcom 1942 ! 1943 CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_min, localcomm, ierror ) 1944 ! 860 ilocalcomm = mpi_comm_opa 861 IF( PRESENT(kcom) ) ilocalcomm = kcom 862 CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_min, ilocalcomm, ierror ) 1945 863 ktab(:) = iwork(:) 1946 !1947 864 END SUBROUTINE mppmin_a_int 1948 1949 865 !! 1950 866 SUBROUTINE mppmin_int( ktab, kcom ) 1951 !!----------------------------------------------------------------------1952 !! *** routine mppmin_int ***1953 !!1954 !! ** Purpose : Find minimum value in an integer layout array1955 !!1956 867 !!---------------------------------------------------------------------- 1957 868 INTEGER, INTENT(inout) :: ktab ! ??? 1958 869 INTEGER , INTENT( in ), OPTIONAL :: kcom ! input array 1959 870 !! 1960 INTEGER :: ierror, iwork, localcomm 1961 !!---------------------------------------------------------------------- 1962 ! 1963 localcomm = mpi_comm_opa 1964 IF( PRESENT(kcom) ) localcomm = kcom 1965 ! 1966 CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_min, localcomm, ierror ) 1967 ! 871 INTEGER :: ierror, iwork, ilocalcomm 872 !!---------------------------------------------------------------------- 873 ilocalcomm = mpi_comm_opa 874 IF( PRESENT(kcom) ) ilocalcomm = kcom 875 CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_min, ilocalcomm, ierror ) 1968 876 ktab = iwork 1969 !1970 877 END SUBROUTINE mppmin_int 1971 1972 1973 SUBROUTINE mppsum_a_int( ktab, kdim ) 1974 !!---------------------------------------------------------------------- 1975 !! *** routine mppsum_a_int *** 1976 !! 1977 !! ** Purpose : Global integer sum, 1D array case 1978 !! 1979 !!---------------------------------------------------------------------- 1980 INTEGER, INTENT(in ) :: kdim ! ??? 1981 INTEGER, INTENT(inout), DIMENSION (kdim) :: ktab ! ??? 1982 ! 1983 INTEGER :: ierror 1984 INTEGER, DIMENSION (kdim) :: iwork 1985 !!---------------------------------------------------------------------- 1986 ! 1987 CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_sum, mpi_comm_opa, ierror ) 1988 ! 1989 ktab(:) = iwork(:) 1990 ! 1991 END SUBROUTINE mppsum_a_int 1992 1993 1994 SUBROUTINE mppsum_int( ktab ) 1995 !!---------------------------------------------------------------------- 1996 !! *** routine mppsum_int *** 1997 !! 1998 !! ** Purpose : Global integer sum 1999 !! 2000 !!---------------------------------------------------------------------- 2001 INTEGER, INTENT(inout) :: ktab 2002 !! 2003 INTEGER :: ierror, iwork 2004 !!---------------------------------------------------------------------- 2005 ! 2006 CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_sum, mpi_comm_opa, ierror ) 2007 ! 2008 ktab = iwork 2009 ! 2010 END SUBROUTINE mppsum_int 2011 2012 2013 SUBROUTINE mppmax_a_real( ptab, kdim, kcom ) 2014 !!---------------------------------------------------------------------- 2015 !! *** routine mppmax_a_real *** 2016 !! 2017 !! ** Purpose : Maximum 2018 !! 878 !! 879 SUBROUTINE mppmin_a_real( ptab, kdim, kcom ) 2019 880 !!---------------------------------------------------------------------- 2020 881 INTEGER , INTENT(in ) :: kdim 2021 882 REAL(wp), INTENT(inout), DIMENSION(kdim) :: ptab 2022 883 INTEGER , INTENT(in ), OPTIONAL :: kcom 2023 ! 2024 INTEGER :: ierror, localcomm 2025 REAL(wp), DIMENSION(kdim) :: zwork 2026 !!---------------------------------------------------------------------- 2027 ! 2028 localcomm = mpi_comm_opa 2029 IF( PRESENT(kcom) ) localcomm = kcom 2030 ! 2031 CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_max, localcomm, ierror ) 2032 ptab(:) = zwork(:) 2033 ! 2034 END SUBROUTINE mppmax_a_real 2035 2036 2037 SUBROUTINE mppmax_real( ptab, kcom ) 2038 !!---------------------------------------------------------------------- 2039 !! *** routine mppmax_real *** 2040 !! 2041 !! ** Purpose : Maximum 2042 !! 2043 !!---------------------------------------------------------------------- 2044 REAL(wp), INTENT(inout) :: ptab ! ??? 2045 INTEGER , INTENT(in ), OPTIONAL :: kcom ! ??? 2046 !! 2047 INTEGER :: ierror, localcomm 2048 REAL(wp) :: zwork 2049 !!---------------------------------------------------------------------- 2050 ! 2051 localcomm = mpi_comm_opa 2052 IF( PRESENT(kcom) ) localcomm = kcom 2053 ! 2054 CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_max, localcomm, ierror ) 2055 ptab = zwork 2056 ! 2057 END SUBROUTINE mppmax_real 2058 2059 SUBROUTINE mppmax_real_multiple( ptab, NUM , kcom ) 2060 !!---------------------------------------------------------------------- 2061 !! *** routine mppmax_real *** 2062 !! 2063 !! ** Purpose : Maximum 2064 !! 2065 !!---------------------------------------------------------------------- 2066 REAL(wp), DIMENSION(:) , INTENT(inout) :: ptab ! ??? 2067 INTEGER , INTENT(in ) :: NUM 2068 INTEGER , INTENT(in ), OPTIONAL :: kcom ! ??? 2069 !! 2070 INTEGER :: ierror, localcomm 2071 REAL(wp) , POINTER , DIMENSION(:) :: zwork 2072 !!---------------------------------------------------------------------- 2073 ! 2074 CALL wrk_alloc(NUM , zwork) 2075 localcomm = mpi_comm_opa 2076 IF( PRESENT(kcom) ) localcomm = kcom 2077 ! 2078 CALL mpi_allreduce( ptab, zwork, NUM, mpi_double_precision, mpi_max, localcomm, ierror ) 2079 ptab = zwork 2080 CALL wrk_dealloc(NUM , zwork) 2081 ! 2082 END SUBROUTINE mppmax_real_multiple 2083 2084 2085 SUBROUTINE mppmin_a_real( ptab, kdim, kcom ) 2086 !!---------------------------------------------------------------------- 2087 !! *** routine mppmin_a_real *** 2088 !! 2089 !! ** Purpose : Minimum of REAL, array case 2090 !! 2091 !!----------------------------------------------------------------------- 2092 INTEGER , INTENT(in ) :: kdim 2093 REAL(wp), INTENT(inout), DIMENSION(kdim) :: ptab 2094 INTEGER , INTENT(in ), OPTIONAL :: kcom 2095 !! 2096 INTEGER :: ierror, localcomm 884 INTEGER :: ierror, ilocalcomm 2097 885 REAL(wp), DIMENSION(kdim) :: zwork 2098 886 !!----------------------------------------------------------------------- 2099 ! 2100 localcomm = mpi_comm_opa 2101 IF( PRESENT(kcom) ) localcomm = kcom 2102 ! 2103 CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_min, localcomm, ierror ) 887 ilocalcomm = mpi_comm_opa 888 IF( PRESENT(kcom) ) ilocalcomm = kcom 889 CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_min, ilocalcomm, ierror ) 2104 890 ptab(:) = zwork(:) 2105 !2106 891 END SUBROUTINE mppmin_a_real 2107 2108 892 !! 2109 893 SUBROUTINE mppmin_real( ptab, kcom ) 2110 !!----------------------------------------------------------------------2111 !! *** routine mppmin_real ***2112 !!2113 !! ** Purpose : minimum of REAL, scalar case2114 !!2115 894 !!----------------------------------------------------------------------- 2116 895 REAL(wp), INTENT(inout) :: ptab ! 2117 896 INTEGER , INTENT(in ), OPTIONAL :: kcom 2118 !! 2119 INTEGER :: ierror 2120 REAL(wp) :: zwork 2121 INTEGER :: localcomm 2122 !!----------------------------------------------------------------------- 2123 ! 2124 localcomm = mpi_comm_opa 2125 IF( PRESENT(kcom) ) localcomm = kcom 2126 ! 2127 CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_min, localcomm, ierror ) 2128 ptab = zwork 2129 ! 2130 END SUBROUTINE mppmin_real 2131 2132 2133 SUBROUTINE mppsum_a_real( ptab, kdim, kcom ) 2134 !!---------------------------------------------------------------------- 2135 !! *** routine mppsum_a_real *** 2136 !! 2137 !! ** Purpose : global sum, REAL ARRAY argument case 2138 !! 2139 !!----------------------------------------------------------------------- 2140 INTEGER , INTENT( in ) :: kdim ! size of ptab 2141 REAL(wp), DIMENSION(kdim), INTENT( inout ) :: ptab ! input array 2142 INTEGER , INTENT( in ), OPTIONAL :: kcom 2143 !! 2144 INTEGER :: ierror ! temporary integer 2145 INTEGER :: localcomm 2146 REAL(wp), DIMENSION(kdim) :: zwork ! temporary workspace 2147 !!----------------------------------------------------------------------- 2148 ! 2149 localcomm = mpi_comm_opa 2150 IF( PRESENT(kcom) ) localcomm = kcom 2151 ! 2152 CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_sum, localcomm, ierror ) 2153 ptab(:) = zwork(:) 2154 ! 2155 END SUBROUTINE mppsum_a_real 2156 2157 2158 SUBROUTINE mppsum_real( ptab, kcom ) 2159 !!---------------------------------------------------------------------- 2160 !! *** routine mppsum_real *** 2161 !! 2162 !! ** Purpose : global sum, SCALAR argument case 2163 !! 2164 !!----------------------------------------------------------------------- 2165 REAL(wp), INTENT(inout) :: ptab ! input scalar 2166 INTEGER , INTENT(in ), OPTIONAL :: kcom 2167 !! 2168 INTEGER :: ierror, localcomm 897 INTEGER :: ierror, ilocalcomm 2169 898 REAL(wp) :: zwork 2170 899 !!----------------------------------------------------------------------- 2171 ! 2172 localcomm = mpi_comm_opa 2173 IF( PRESENT(kcom) ) localcomm = kcom 2174 ! 2175 CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_sum, localcomm, ierror ) 900 ilocalcomm = mpi_comm_opa 901 IF( PRESENT(kcom) ) ilocalcomm = kcom 902 CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_min, ilocalcomm, ierror ) 2176 903 ptab = zwork 2177 ! 904 END SUBROUTINE mppmin_real 905 906 907 !!---------------------------------------------------------------------- 908 !! *** mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real *** 909 !! 910 !! Global sum of 1D array or a variable (integer, real or complex) 911 !!---------------------------------------------------------------------- 912 !! 913 SUBROUTINE mppsum_a_int( ktab, kdim ) 914 !!---------------------------------------------------------------------- 915 INTEGER, INTENT(in ) :: kdim ! ??? 916 INTEGER, INTENT(inout), DIMENSION (kdim) :: ktab ! ??? 917 INTEGER :: ierror 918 INTEGER, DIMENSION (kdim) :: iwork 919 !!---------------------------------------------------------------------- 920 CALL mpi_allreduce( ktab, iwork, kdim, mpi_integer, mpi_sum, mpi_comm_opa, ierror ) 921 ktab(:) = iwork(:) 922 END SUBROUTINE mppsum_a_int 923 !! 924 SUBROUTINE mppsum_int( ktab ) 925 !!---------------------------------------------------------------------- 926 INTEGER, INTENT(inout) :: ktab 927 INTEGER :: ierror, iwork 928 !!---------------------------------------------------------------------- 929 CALL mpi_allreduce( ktab, iwork, 1, mpi_integer, mpi_sum, mpi_comm_opa, ierror ) 930 ktab = iwork 931 END SUBROUTINE mppsum_int 932 !! 933 SUBROUTINE mppsum_a_real( ptab, kdim, kcom ) 934 !!----------------------------------------------------------------------- 935 INTEGER , INTENT(in ) :: kdim ! size of ptab 936 REAL(wp), DIMENSION(kdim), INTENT(inout) :: ptab ! input array 937 INTEGER , OPTIONAL , INTENT(in ) :: kcom ! specific communicator 938 INTEGER :: ierror, ilocalcomm ! local integer 939 REAL(wp) :: zwork(kdim) ! local workspace 940 !!----------------------------------------------------------------------- 941 ilocalcomm = mpi_comm_opa 942 IF( PRESENT(kcom) ) ilocalcomm = kcom 943 CALL mpi_allreduce( ptab, zwork, kdim, mpi_double_precision, mpi_sum, ilocalcomm, ierror ) 944 ptab(:) = zwork(:) 945 END SUBROUTINE mppsum_a_real 946 !! 947 SUBROUTINE mppsum_real( ptab, kcom ) 948 !!----------------------------------------------------------------------- 949 REAL(wp) , INTENT(inout) :: ptab ! input scalar 950 INTEGER , OPTIONAL, INTENT(in ) :: kcom 951 INTEGER :: ierror, ilocalcomm 952 REAL(wp) :: zwork 953 !!----------------------------------------------------------------------- 954 ilocalcomm = mpi_comm_opa 955 IF( PRESENT(kcom) ) ilocalcomm = kcom 956 CALL mpi_allreduce( ptab, zwork, 1, mpi_double_precision, mpi_sum, ilocalcomm, ierror ) 957 ptab = zwork 2178 958 END SUBROUTINE mppsum_real 2179 2180 959 !! 2181 960 SUBROUTINE mppsum_realdd( ytab, kcom ) 2182 !!----------------------------------------------------------------------2183 !! *** routine mppsum_realdd ***2184 !!2185 !! ** Purpose : global sum in Massively Parallel Processing2186 !! SCALAR argument case for double-double precision2187 !!2188 961 !!----------------------------------------------------------------------- 2189 COMPLEX(wp), INTENT(inout) :: ytab ! input scalar 2190 INTEGER , INTENT(in ), OPTIONAL :: kcom 2191 ! 2192 INTEGER :: ierror 2193 INTEGER :: localcomm 962 COMPLEX(wp) , INTENT(inout) :: ytab ! input scalar 963 INTEGER , OPTIONAL, INTENT(in ) :: kcom 964 INTEGER :: ierror, ilocalcomm 2194 965 COMPLEX(wp) :: zwork 2195 966 !!----------------------------------------------------------------------- 2196 ! 2197 localcomm = mpi_comm_opa 2198 IF( PRESENT(kcom) ) localcomm = kcom 2199 ! 2200 ! reduce local sums into global sum 2201 CALL MPI_ALLREDUCE (ytab, zwork, 1, MPI_DOUBLE_COMPLEX, MPI_SUMDD, localcomm, ierror ) 967 ilocalcomm = mpi_comm_opa 968 IF( PRESENT(kcom) ) ilocalcomm = kcom 969 CALL MPI_ALLREDUCE( ytab, zwork, 1, MPI_DOUBLE_COMPLEX, MPI_SUMDD, ilocalcomm, ierror ) 2202 970 ytab = zwork 2203 !2204 971 END SUBROUTINE mppsum_realdd 2205 2206 972 !! 2207 973 SUBROUTINE mppsum_a_realdd( ytab, kdim, kcom ) 2208 974 !!---------------------------------------------------------------------- 2209 !! *** routine mppsum_a_realdd ***2210 !!2211 !! ** Purpose : global sum in Massively Parallel Processing2212 !! COMPLEX ARRAY case for double-double precision2213 !!2214 !!-----------------------------------------------------------------------2215 975 INTEGER , INTENT(in ) :: kdim ! size of ytab 2216 976 COMPLEX(wp), DIMENSION(kdim), INTENT(inout) :: ytab ! input array 2217 977 INTEGER , OPTIONAL , INTENT(in ) :: kcom 2218 ! 2219 INTEGER:: ierror, localcomm ! local integer 978 INTEGER:: ierror, ilocalcomm ! local integer 2220 979 COMPLEX(wp), DIMENSION(kdim) :: zwork ! temporary workspace 2221 980 !!----------------------------------------------------------------------- 2222 ! 2223 localcomm = mpi_comm_opa 2224 IF( PRESENT(kcom) ) localcomm = kcom 2225 ! 2226 CALL MPI_ALLREDUCE( ytab, zwork, kdim, MPI_DOUBLE_COMPLEX, MPI_SUMDD, localcomm, ierror ) 981 ilocalcomm = mpi_comm_opa 982 IF( PRESENT(kcom) ) ilocalcomm = kcom 983 CALL MPI_ALLREDUCE( ytab, zwork, kdim, MPI_DOUBLE_COMPLEX, MPI_SUMDD, ilocalcomm, ierror ) 2227 984 ytab(:) = zwork(:) 2228 !2229 985 END SUBROUTINE mppsum_a_realdd 986 987 988 SUBROUTINE mppmax_real_multiple( pt1d, kdim, kcom ) 989 !!---------------------------------------------------------------------- 990 !! *** routine mppmax_real *** 991 !! 992 !! ** Purpose : Maximum across processor of each element of a 1D arrays 993 !! 994 !!---------------------------------------------------------------------- 995 REAL(wp), DIMENSION(kdim), INTENT(inout) :: pt1d ! 1D arrays 996 INTEGER , INTENT(in ) :: kdim 997 INTEGER , OPTIONAL , INTENT(in ) :: kcom ! local communicator 998 !! 999 INTEGER :: ierror, ilocalcomm 1000 REAL(wp), DIMENSION(kdim) :: zwork 1001 !!---------------------------------------------------------------------- 1002 ilocalcomm = mpi_comm_opa 1003 IF( PRESENT(kcom) ) ilocalcomm = kcom 1004 ! 1005 CALL mpi_allreduce( pt1d, zwork, kdim, mpi_double_precision, mpi_max, ilocalcomm, ierror ) 1006 pt1d(:) = zwork(:) 1007 ! 1008 END SUBROUTINE mppmax_real_multiple 2230 1009 2231 1010 … … 2243 1022 REAL(wp), DIMENSION (jpi,jpj), INTENT(in ) :: pmask ! Local mask 2244 1023 REAL(wp) , INTENT( out) :: pmin ! Global minimum of ptab 2245 INTEGER , INTENT( out) :: ki, kj 1024 INTEGER , INTENT( out) :: ki, kj ! index of minimum in global frame 2246 1025 ! 2247 1026 INTEGER :: ierror … … 2251 1030 !!----------------------------------------------------------------------- 2252 1031 ! 2253 zmin = MINVAL( ptab(:,:) , mask= pmask == 1. e0)2254 ilocs = MINLOC( ptab(:,:) , mask= pmask == 1. e0)1032 zmin = MINVAL( ptab(:,:) , mask= pmask == 1._wp ) 1033 ilocs = MINLOC( ptab(:,:) , mask= pmask == 1._wp ) 2255 1034 ! 2256 1035 ki = ilocs(1) + nimpp - 1 … … 2279 1058 !! 2280 1059 !!-------------------------------------------------------------------------- 2281 REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in ) :: ptab ! Local 2D array2282 REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in ) :: pmask ! Local mask2283 REAL(wp) 2284 INTEGER 2285 ! !1060 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: ptab ! Local 2D array 1061 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pmask ! Local mask 1062 REAL(wp) , INTENT( out) :: pmin ! Global minimum of ptab 1063 INTEGER , INTENT( out) :: ki, kj, kk ! index of minimum in global frame 1064 ! 2286 1065 INTEGER :: ierror 2287 1066 REAL(wp) :: zmin ! local minimum … … 2290 1069 !!----------------------------------------------------------------------- 2291 1070 ! 2292 zmin = MINVAL( ptab(:,:,:) , mask= pmask == 1. e0)2293 ilocs = MINLOC( ptab(:,:,:) , mask= pmask == 1. e0)1071 zmin = MINVAL( ptab(:,:,:) , mask= pmask == 1._wp ) 1072 ilocs = MINLOC( ptab(:,:,:) , mask= pmask == 1._wp ) 2294 1073 ! 2295 1074 ki = ilocs(1) + nimpp - 1 … … 2297 1076 kk = ilocs(3) 2298 1077 ! 2299 zain(1,:) =zmin2300 zain(2,:) =ki+10000.*kj+100000000.*kk1078 zain(1,:) = zmin 1079 zain(2,:) = ki + 10000.*kj + 100000000.*kk 2301 1080 ! 2302 1081 CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MINLOC,MPI_COMM_OPA,ierror) … … 2331 1110 !!----------------------------------------------------------------------- 2332 1111 ! 2333 zmax = MAXVAL( ptab(:,:) , mask= pmask == 1. e0)2334 ilocs = MAXLOC( ptab(:,:) , mask= pmask == 1. e0)1112 zmax = MAXVAL( ptab(:,:) , mask= pmask == 1._wp ) 1113 ilocs = MAXLOC( ptab(:,:) , mask= pmask == 1._wp ) 2335 1114 ! 2336 1115 ki = ilocs(1) + nimpp - 1 … … 2359 1138 !! 2360 1139 !!-------------------------------------------------------------------------- 2361 REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in ) :: ptab ! Local 2D array 2362 REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in ) :: pmask ! Local mask 2363 REAL(wp) , INTENT( out) :: pmax ! Global maximum of ptab 2364 INTEGER , INTENT( out) :: ki, kj, kk ! index of maximum in global frame 2365 !! 2366 REAL(wp) :: zmax ! local maximum 1140 REAL(wp), DIMENSION (:,:,:), INTENT(in ) :: ptab ! Local 2D array 1141 REAL(wp), DIMENSION (:,:,:), INTENT(in ) :: pmask ! Local mask 1142 REAL(wp) , INTENT( out) :: pmax ! Global maximum of ptab 1143 INTEGER , INTENT( out) :: ki, kj, kk ! index of maximum in global frame 1144 ! 1145 INTEGER :: ierror ! local integer 1146 REAL(wp) :: zmax ! local maximum 2367 1147 REAL(wp), DIMENSION(2,1) :: zain, zaout 2368 1148 INTEGER , DIMENSION(3) :: ilocs 2369 INTEGER :: ierror2370 1149 !!----------------------------------------------------------------------- 2371 1150 ! 2372 zmax = MAXVAL( ptab(:,:,:) , mask= pmask == 1. e0)2373 ilocs = MAXLOC( ptab(:,:,:) , mask= pmask == 1. e0)1151 zmax = MAXVAL( ptab(:,:,:) , mask= pmask == 1._wp ) 1152 ilocs = MAXLOC( ptab(:,:,:) , mask= pmask == 1._wp ) 2374 1153 ! 2375 1154 ki = ilocs(1) + nimpp - 1 … … 2377 1156 kk = ilocs(3) 2378 1157 ! 2379 zain(1,:) =zmax2380 zain(2,:) =ki+10000.*kj+100000000.*kk1158 zain(1,:) = zmax 1159 zain(2,:) = ki + 10000.*kj + 100000000.*kk 2381 1160 ! 2382 1161 CALL MPI_ALLREDUCE( zain,zaout, 1, MPI_2DOUBLE_PRECISION,MPI_MAXLOC,MPI_COMM_OPA,ierror) … … 2422 1201 2423 1202 SUBROUTINE mpp_comm_free( kcom ) 2424 !!----------------------------------------------------------------------2425 1203 !!---------------------------------------------------------------------- 2426 1204 INTEGER, INTENT(in) :: kcom … … 2680 1458 2681 1459 2682 SUBROUTINE mpp_lbc_north_3d( pt3d, cd_type, psgn )2683 !!---------------------------------------------------------------------2684 !! *** routine mpp_lbc_north_3d ***2685 !!2686 !! ** Purpose : Ensure proper north fold horizontal bondary condition2687 !! in mpp configuration in case of jpn1 > 12688 !!2689 !! ** Method : North fold condition and mpp with more than one proc2690 !! in i-direction require a specific treatment. We gather2691 !! the 4 northern lines of the global domain on 1 processor2692 !! and apply lbc north-fold on this sub array. Then we2693 !! scatter the north fold array back to the processors.2694 !!2695 !!----------------------------------------------------------------------2696 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pt3d ! 3D array on which the b.c. is applied2697 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points2698 ! ! = T , U , V , F or W gridpoints2699 REAL(wp) , INTENT(in ) :: psgn ! = -1. the sign change across the north fold2700 !! ! = 1. , the sign is kept2701 INTEGER :: ji, jj, jr, jk2702 INTEGER :: ierr, itaille, ildi, ilei, iilb2703 INTEGER :: ijpj, ijpjm1, ij, iproc2704 INTEGER, DIMENSION (jpmaxngh) :: ml_req_nf !for mpi_isend when avoiding mpi_allgather2705 INTEGER :: ml_err ! for mpi_isend when avoiding mpi_allgather2706 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for mpi_isend when avoiding mpi_allgather2707 ! ! Workspace for message transfers avoiding mpi_allgather2708 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: ztab2709 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: znorthloc, zfoldwk2710 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: znorthgloio2711 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: ztabl, ztabr2712 2713 INTEGER :: istatus(mpi_status_size)2714 INTEGER :: iflag2715 !!----------------------------------------------------------------------2716 !2717 ALLOCATE( ztab(jpiglo,4,jpk) , znorthloc(jpi,4,jpk), zfoldwk(jpi,4,jpk), znorthgloio(jpi,4,jpk,jpni) )2718 ALLOCATE( ztabl(jpi,4,jpk), ztabr(jpi*jpmaxngh, 4, jpk) )2719 2720 ijpj = 42721 ijpjm1 = 32722 !2723 znorthloc(:,:,:) = 02724 DO jk = 1, jpk2725 DO jj = nlcj - ijpj +1, nlcj ! put in xnorthloc the last 4 jlines of pt3d2726 ij = jj - nlcj + ijpj2727 znorthloc(:,ij,jk) = pt3d(:,jj,jk)2728 END DO2729 END DO2730 !2731 ! ! Build in procs of ncomm_north the znorthgloio2732 itaille = jpi * jpk * ijpj2733 2734 IF ( l_north_nogather ) THEN2735 !2736 ztabr(:,:,:) = 02737 ztabl(:,:,:) = 02738 2739 DO jk = 1, jpk2740 DO jj = nlcj-ijpj+1, nlcj ! First put local values into the global array2741 ij = jj - nlcj + ijpj2742 DO ji = nfsloop, nfeloop2743 ztabl(ji,ij,jk) = pt3d(ji,jj,jk)2744 END DO2745 END DO2746 END DO2747 2748 DO jr = 1,nsndto2749 IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN2750 CALL mppsend( 5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr) )2751 ENDIF2752 END DO2753 DO jr = 1,nsndto2754 iproc = nfipproc(isendto(jr),jpnj)2755 IF(iproc .ne. -1) THEN2756 ilei = nleit (iproc+1)2757 ildi = nldit (iproc+1)2758 iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj)2759 ENDIF2760 IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN2761 CALL mpprecv(5, zfoldwk, itaille, iproc)2762 DO jk = 1, jpk2763 DO jj = 1, ijpj2764 DO ji = ildi, ilei2765 ztabr(iilb+ji,jj,jk) = zfoldwk(ji,jj,jk)2766 END DO2767 END DO2768 END DO2769 ELSE IF (iproc .eq. (narea-1)) THEN2770 DO jk = 1, jpk2771 DO jj = 1, ijpj2772 DO ji = ildi, ilei2773 ztabr(iilb+ji,jj,jk) = pt3d(ji,nlcj-ijpj+jj,jk)2774 END DO2775 END DO2776 END DO2777 ENDIF2778 END DO2779 IF (l_isend) THEN2780 DO jr = 1,nsndto2781 IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN2782 CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err)2783 ENDIF2784 END DO2785 ENDIF2786 CALL mpp_lbc_nfd( ztabl, ztabr, cd_type, psgn ) ! North fold boundary condition2787 DO jk = 1, jpk2788 DO jj = nlcj-ijpj+1, nlcj ! Scatter back to pt3d2789 ij = jj - nlcj + ijpj2790 DO ji= 1, nlci2791 pt3d(ji,jj,jk) = ztabl(ji,ij,jk)2792 END DO2793 END DO2794 END DO2795 !2796 2797 ELSE2798 CALL MPI_ALLGATHER( znorthloc , itaille, MPI_DOUBLE_PRECISION, &2799 & znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )2800 !2801 ztab(:,:,:) = 0.e02802 DO jr = 1, ndim_rank_north ! recover the global north array2803 iproc = nrank_north(jr) + 12804 ildi = nldit (iproc)2805 ilei = nleit (iproc)2806 iilb = nimppt(iproc)2807 DO jk = 1, jpk2808 DO jj = 1, ijpj2809 DO ji = ildi, ilei2810 ztab(ji+iilb-1,jj,jk) = znorthgloio(ji,jj,jk,jr)2811 END DO2812 END DO2813 END DO2814 END DO2815 CALL lbc_nfd( ztab, cd_type, psgn ) ! North fold boundary condition2816 !2817 DO jk = 1, jpk2818 DO jj = nlcj-ijpj+1, nlcj ! Scatter back to pt3d2819 ij = jj - nlcj + ijpj2820 DO ji= 1, nlci2821 pt3d(ji,jj,jk) = ztab(ji+nimpp-1,ij,jk)2822 END DO2823 END DO2824 END DO2825 !2826 ENDIF2827 !2828 ! The ztab array has been either:2829 ! a. Fully populated by the mpi_allgather operation or2830 ! b. Had the active points for this domain and northern neighbours populated2831 ! by peer to peer exchanges2832 ! Either way the array may be folded by lbc_nfd and the result for the span of2833 ! this domain will be identical.2834 !2835 DEALLOCATE( ztab, znorthloc, zfoldwk, znorthgloio )2836 DEALLOCATE( ztabl, ztabr )2837 !2838 END SUBROUTINE mpp_lbc_north_3d2839 2840 2841 SUBROUTINE mpp_lbc_north_2d( pt2d, cd_type, psgn)2842 !!---------------------------------------------------------------------2843 !! *** routine mpp_lbc_north_2d ***2844 !!2845 !! ** Purpose : Ensure proper north fold horizontal bondary condition2846 !! in mpp configuration in case of jpn1 > 1 (for 2d array )2847 !!2848 !! ** Method : North fold condition and mpp with more than one proc2849 !! in i-direction require a specific treatment. We gather2850 !! the 4 northern lines of the global domain on 1 processor2851 !! and apply lbc north-fold on this sub array. Then we2852 !! scatter the north fold array back to the processors.2853 !!2854 !!----------------------------------------------------------------------2855 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pt2d ! 2D array on which the b.c. is applied2856 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt2d grid-points2857 ! ! = T , U , V , F or W gridpoints2858 REAL(wp) , INTENT(in ) :: psgn ! = -1. the sign change across the north fold2859 !! ! = 1. , the sign is kept2860 INTEGER :: ji, jj, jr2861 INTEGER :: ierr, itaille, ildi, ilei, iilb2862 INTEGER :: ijpj, ijpjm1, ij, iproc2863 INTEGER, DIMENSION (jpmaxngh) :: ml_req_nf !for mpi_isend when avoiding mpi_allgather2864 INTEGER :: ml_err ! for mpi_isend when avoiding mpi_allgather2865 INTEGER, DIMENSION(MPI_STATUS_SIZE):: ml_stat ! for mpi_isend when avoiding mpi_allgather2866 ! ! Workspace for message transfers avoiding mpi_allgather2867 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: ztab2868 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: znorthloc, zfoldwk2869 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: znorthgloio2870 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: ztabl, ztabr2871 INTEGER :: istatus(mpi_status_size)2872 INTEGER :: iflag2873 !!----------------------------------------------------------------------2874 !2875 ALLOCATE( ztab(jpiglo,4), znorthloc(jpi,4), zfoldwk(jpi,4), znorthgloio(jpi,4,jpni) )2876 ALLOCATE( ztabl(jpi,4), ztabr(jpi*jpmaxngh, 4) )2877 !2878 ijpj = 42879 ijpjm1 = 32880 !2881 DO jj = nlcj-ijpj+1, nlcj ! put in znorthloc the last 4 jlines of pt2d2882 ij = jj - nlcj + ijpj2883 znorthloc(:,ij) = pt2d(:,jj)2884 END DO2885 2886 ! ! Build in procs of ncomm_north the znorthgloio2887 itaille = jpi * ijpj2888 IF ( l_north_nogather ) THEN2889 !2890 ! Avoid the use of mpi_allgather by exchanging only with the processes already identified2891 ! (in nemo_northcomms) as being involved in this process' northern boundary exchange2892 !2893 ztabr(:,:) = 02894 ztabl(:,:) = 02895 2896 DO jj = nlcj-ijpj+1, nlcj ! First put local values into the global array2897 ij = jj - nlcj + ijpj2898 DO ji = nfsloop, nfeloop2899 ztabl(ji,ij) = pt2d(ji,jj)2900 END DO2901 END DO2902 2903 DO jr = 1,nsndto2904 IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN2905 CALL mppsend(5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr))2906 ENDIF2907 END DO2908 DO jr = 1,nsndto2909 iproc = nfipproc(isendto(jr),jpnj)2910 IF(iproc .ne. -1) THEN2911 ilei = nleit (iproc+1)2912 ildi = nldit (iproc+1)2913 iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj)2914 ENDIF2915 IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN2916 CALL mpprecv(5, zfoldwk, itaille, iproc)2917 DO jj = 1, ijpj2918 DO ji = ildi, ilei2919 ztabr(iilb+ji,jj) = zfoldwk(ji,jj)2920 END DO2921 END DO2922 ELSE IF (iproc .eq. (narea-1)) THEN2923 DO jj = 1, ijpj2924 DO ji = ildi, ilei2925 ztabr(iilb+ji,jj) = pt2d(ji,nlcj-ijpj+jj)2926 END DO2927 END DO2928 ENDIF2929 END DO2930 IF (l_isend) THEN2931 DO jr = 1,nsndto2932 IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN2933 CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err)2934 ENDIF2935 END DO2936 ENDIF2937 CALL mpp_lbc_nfd( ztabl, ztabr, cd_type, psgn ) ! North fold boundary condition2938 !2939 DO jj = nlcj-ijpj+1, nlcj ! Scatter back to pt2d2940 ij = jj - nlcj + ijpj2941 DO ji = 1, nlci2942 pt2d(ji,jj) = ztabl(ji,ij)2943 END DO2944 END DO2945 !2946 ELSE2947 CALL MPI_ALLGATHER( znorthloc , itaille, MPI_DOUBLE_PRECISION, &2948 & znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )2949 !2950 ztab(:,:) = 0.e02951 DO jr = 1, ndim_rank_north ! recover the global north array2952 iproc = nrank_north(jr) + 12953 ildi = nldit (iproc)2954 ilei = nleit (iproc)2955 iilb = nimppt(iproc)2956 DO jj = 1, ijpj2957 DO ji = ildi, ilei2958 ztab(ji+iilb-1,jj) = znorthgloio(ji,jj,jr)2959 END DO2960 END DO2961 END DO2962 CALL lbc_nfd( ztab, cd_type, psgn ) ! North fold boundary condition2963 !2964 DO jj = nlcj-ijpj+1, nlcj ! Scatter back to pt2d2965 ij = jj - nlcj + ijpj2966 DO ji = 1, nlci2967 pt2d(ji,jj) = ztab(ji+nimpp-1,ij)2968 END DO2969 END DO2970 !2971 ENDIF2972 DEALLOCATE( ztab, znorthloc, zfoldwk, znorthgloio )2973 DEALLOCATE( ztabl, ztabr )2974 !2975 END SUBROUTINE mpp_lbc_north_2d2976 2977 SUBROUTINE mpp_lbc_north_2d_multiple( pt2d_array, cd_type, psgn, num_fields)2978 !!---------------------------------------------------------------------2979 !! *** routine mpp_lbc_north_2d ***2980 !!2981 !! ** Purpose : Ensure proper north fold horizontal bondary condition2982 !! in mpp configuration in case of jpn1 > 12983 !! (for multiple 2d arrays )2984 !!2985 !! ** Method : North fold condition and mpp with more than one proc2986 !! in i-direction require a specific treatment. We gather2987 !! the 4 northern lines of the global domain on 1 processor2988 !! and apply lbc north-fold on this sub array. Then we2989 !! scatter the north fold array back to the processors.2990 !!2991 !!----------------------------------------------------------------------2992 INTEGER , INTENT (in ) :: num_fields ! number of variables contained in pt2d2993 TYPE( arrayptr ), DIMENSION(:) :: pt2d_array2994 CHARACTER(len=1), DIMENSION(:), INTENT(in ) :: cd_type ! nature of pt2d grid-points2995 ! ! = T , U , V , F or W gridpoints2996 REAL(wp), DIMENSION(:), INTENT(in ) :: psgn ! = -1. the sign change across the north fold2997 !! ! = 1. , the sign is kept2998 INTEGER :: ji, jj, jr, jk2999 INTEGER :: ierr, itaille, ildi, ilei, iilb3000 INTEGER :: ijpj, ijpjm1, ij, iproc3001 INTEGER, DIMENSION (jpmaxngh) :: ml_req_nf !for mpi_isend when avoiding mpi_allgather3002 INTEGER :: ml_err ! for mpi_isend when avoiding mpi_allgather3003 INTEGER, DIMENSION(MPI_STATUS_SIZE):: ml_stat ! for mpi_isend when avoiding mpi_allgather3004 ! ! Workspace for message transfers avoiding mpi_allgather3005 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: ztab3006 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: znorthloc, zfoldwk3007 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: znorthgloio3008 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: ztabl, ztabr3009 INTEGER :: istatus(mpi_status_size)3010 INTEGER :: iflag3011 !!----------------------------------------------------------------------3012 !3013 ALLOCATE( ztab(jpiglo,4,num_fields), znorthloc(jpi,4,num_fields), zfoldwk(jpi,4,num_fields), &3014 & znorthgloio(jpi,4,num_fields,jpni) ) ! expanded to 3 dimensions3015 ALLOCATE( ztabl(jpi,4,num_fields), ztabr(jpi*jpmaxngh, 4,num_fields) )3016 !3017 ijpj = 43018 ijpjm1 = 33019 !3020 3021 DO jk = 1, num_fields3022 DO jj = nlcj-ijpj+1, nlcj ! put in znorthloc the last 4 jlines of pt2d (for every variable)3023 ij = jj - nlcj + ijpj3024 znorthloc(:,ij,jk) = pt2d_array(jk)%pt2d(:,jj)3025 END DO3026 END DO3027 ! ! Build in procs of ncomm_north the znorthgloio3028 itaille = jpi * ijpj3029 3030 IF ( l_north_nogather ) THEN3031 !3032 ! Avoid the use of mpi_allgather by exchanging only with the processes already identified3033 ! (in nemo_northcomms) as being involved in this process' northern boundary exchange3034 !3035 ztabr(:,:,:) = 03036 ztabl(:,:,:) = 03037 3038 DO jk = 1, num_fields3039 DO jj = nlcj-ijpj+1, nlcj ! First put local values into the global array3040 ij = jj - nlcj + ijpj3041 DO ji = nfsloop, nfeloop3042 ztabl(ji,ij,jk) = pt2d_array(jk)%pt2d(ji,jj)3043 END DO3044 END DO3045 END DO3046 3047 DO jr = 1,nsndto3048 IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN3049 CALL mppsend(5, znorthloc, itaille*num_fields, nfipproc(isendto(jr),jpnj), ml_req_nf(jr)) ! Buffer expanded "num_fields" times3050 ENDIF3051 END DO3052 DO jr = 1,nsndto3053 iproc = nfipproc(isendto(jr),jpnj)3054 IF(iproc .ne. -1) THEN3055 ilei = nleit (iproc+1)3056 ildi = nldit (iproc+1)3057 iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj)3058 ENDIF3059 IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN3060 CALL mpprecv(5, zfoldwk, itaille*num_fields, iproc) ! Buffer expanded "num_fields" times3061 DO jk = 1 , num_fields3062 DO jj = 1, ijpj3063 DO ji = ildi, ilei3064 ztabr(iilb+ji,jj,jk) = zfoldwk(ji,jj,jk) ! Modified to 3D3065 END DO3066 END DO3067 END DO3068 ELSE IF (iproc .eq. (narea-1)) THEN3069 DO jk = 1, num_fields3070 DO jj = 1, ijpj3071 DO ji = ildi, ilei3072 ztabr(iilb+ji,jj,jk) = pt2d_array(jk)%pt2d(ji,nlcj-ijpj+jj) ! Modified to 3D3073 END DO3074 END DO3075 END DO3076 ENDIF3077 END DO3078 IF (l_isend) THEN3079 DO jr = 1,nsndto3080 IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN3081 CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err)3082 ENDIF3083 END DO3084 ENDIF3085 !3086 DO ji = 1, num_fields ! Loop to manage 3D variables3087 CALL mpp_lbc_nfd( ztabl(:,:,ji), ztabr(:,:,ji), cd_type(ji), psgn(ji) ) ! North fold boundary condition3088 END DO3089 !3090 DO jk = 1, num_fields3091 DO jj = nlcj-ijpj+1, nlcj ! Scatter back to pt2d3092 ij = jj - nlcj + ijpj3093 DO ji = 1, nlci3094 pt2d_array(jk)%pt2d(ji,jj) = ztabl(ji,ij,jk) ! Modified to 3D3095 END DO3096 END DO3097 END DO3098 3099 !3100 ELSE3101 !3102 CALL MPI_ALLGATHER( znorthloc , itaille*num_fields, MPI_DOUBLE_PRECISION, &3103 & znorthgloio, itaille*num_fields, MPI_DOUBLE_PRECISION, ncomm_north, ierr )3104 !3105 ztab(:,:,:) = 0.e03106 DO jk = 1, num_fields3107 DO jr = 1, ndim_rank_north ! recover the global north array3108 iproc = nrank_north(jr) + 13109 ildi = nldit (iproc)3110 ilei = nleit (iproc)3111 iilb = nimppt(iproc)3112 DO jj = 1, ijpj3113 DO ji = ildi, ilei3114 ztab(ji+iilb-1,jj,jk) = znorthgloio(ji,jj,jk,jr)3115 END DO3116 END DO3117 END DO3118 END DO3119 3120 DO ji = 1, num_fields3121 CALL lbc_nfd( ztab(:,:,ji), cd_type(ji), psgn(ji) ) ! North fold boundary condition3122 END DO3123 !3124 DO jk = 1, num_fields3125 DO jj = nlcj-ijpj+1, nlcj ! Scatter back to pt2d3126 ij = jj - nlcj + ijpj3127 DO ji = 1, nlci3128 pt2d_array(jk)%pt2d(ji,jj) = ztab(ji+nimpp-1,ij,jk)3129 END DO3130 END DO3131 END DO3132 !3133 !3134 ENDIF3135 DEALLOCATE( ztab, znorthloc, zfoldwk, znorthgloio )3136 DEALLOCATE( ztabl, ztabr )3137 !3138 END SUBROUTINE mpp_lbc_north_2d_multiple3139 3140 1460 SUBROUTINE mpp_lbc_north_e( pt2d, cd_type, psgn) 3141 1461 !!--------------------------------------------------------------------- … … 3155 1475 REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj), INTENT(inout) :: pt2d ! 2D array with extra halo 3156 1476 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points 3157 ! ! = T , U , V , F or W -points 3158 REAL(wp) , INTENT(in ) :: psgn ! = -1. the sign change across the 3159 !! ! north fold, = 1. otherwise 1477 REAL(wp) , INTENT(in ) :: psgn ! sign used across the north fold 1478 ! 3160 1479 INTEGER :: ji, jj, jr 3161 1480 INTEGER :: ierr, itaille, ildi, ilei, iilb 3162 1481 INTEGER :: ijpj, ij, iproc 3163 !3164 1482 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: ztab_e, znorthloc_e 3165 1483 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: znorthgloio_e 3166 3167 1484 !!---------------------------------------------------------------------- 3168 1485 ! 3169 1486 ALLOCATE( ztab_e(jpiglo,4+2*jpr2dj), znorthloc_e(jpi,4+2*jpr2dj), znorthgloio_e(jpi,4+2*jpr2dj,jpni) ) 3170 3171 1487 ! 3172 1488 ijpj=4 3173 ztab_e(:,:) = 0. e03174 3175 ij =01489 ztab_e(:,:) = 0._wp 1490 1491 ij = 0 3176 1492 ! put in znorthloc_e the last 4 jlines of pt2d 3177 1493 DO jj = nlcj - ijpj + 1 - jpr2dj, nlcj +jpr2dj 3178 1494 ij = ij + 1 3179 1495 DO ji = 1, jpi 3180 znorthloc_e(ji,ij) =pt2d(ji,jj)1496 znorthloc_e(ji,ij) = pt2d(ji,jj) 3181 1497 END DO 3182 1498 END DO 3183 1499 ! 3184 1500 itaille = jpi * ( ijpj + 2 * jpr2dj ) 3185 CALL MPI_ALLGATHER( znorthloc_e(1,1) , itaille, MPI_DOUBLE_PRECISION, &1501 CALL MPI_ALLGATHER( znorthloc_e(1,1) , itaille, MPI_DOUBLE_PRECISION, & 3186 1502 & znorthgloio_e(1,1,1), itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 3187 1503 ! 3188 1504 DO jr = 1, ndim_rank_north ! recover the global north array 3189 1505 iproc = nrank_north(jr) + 1 3190 ildi = nldit (iproc)3191 ilei = nleit (iproc)3192 iilb = nimppt(iproc)1506 ildi = nldit (iproc) 1507 ilei = nleit (iproc) 1508 iilb = nimppt(iproc) 3193 1509 DO jj = 1, ijpj+2*jpr2dj 3194 1510 DO ji = ildi, ilei … … 3198 1514 END DO 3199 1515 3200 3201 1516 ! 2. North-Fold boundary conditions 3202 1517 ! ---------------------------------- 3203 CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, pr2dj = jpr2dj )1518 !!gm ERROR CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, pr2dj = jpr2dj ) 3204 1519 3205 1520 ij = jpr2dj … … 3215 1530 ! 3216 1531 END SUBROUTINE mpp_lbc_north_e 3217 3218 3219 SUBROUTINE mpp_lnk_bdy_3d( ptab, cd_type, psgn, ib_bdy )3220 !!----------------------------------------------------------------------3221 !! *** routine mpp_lnk_bdy_3d ***3222 !!3223 !! ** Purpose : Message passing management3224 !!3225 !! ** Method : Use mppsend and mpprecv function for passing BDY boundaries3226 !! between processors following neighboring subdomains.3227 !! domain parameters3228 !! nlci : first dimension of the local subdomain3229 !! nlcj : second dimension of the local subdomain3230 !! nbondi_bdy : mark for "east-west local boundary"3231 !! nbondj_bdy : mark for "north-south local boundary"3232 !! noea : number for local neighboring processors3233 !! nowe : number for local neighboring processors3234 !! noso : number for local neighboring processors3235 !! nono : number for local neighboring processors3236 !!3237 !! ** Action : ptab with update value at its periphery3238 !!3239 !!----------------------------------------------------------------------3240 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: ptab ! 3D array on which the boundary condition is applied3241 CHARACTER(len=1) , INTENT(in ) :: cd_type ! define the nature of ptab array grid-points3242 ! ! = T , U , V , F , W points3243 REAL(wp) , INTENT(in ) :: psgn ! =-1 the sign change across the north fold boundary3244 ! ! = 1. , the sign is kept3245 INTEGER , INTENT(in ) :: ib_bdy ! BDY boundary set3246 !3247 INTEGER :: ji, jj, jk, jl ! dummy loop indices3248 INTEGER :: imigr, iihom, ijhom ! local integers3249 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend3250 REAL(wp) :: zland ! local scalar3251 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend3252 !3253 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zt3ns, zt3sn ! 3d for north-south & south-north3254 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: zt3ew, zt3we ! 3d for east-west & west-east3255 !!----------------------------------------------------------------------3256 !3257 ALLOCATE( zt3ns(jpi,jprecj,jpk,2), zt3sn(jpi,jprecj,jpk,2), &3258 & zt3ew(jpj,jpreci,jpk,2), zt3we(jpj,jpreci,jpk,2) )3259 3260 zland = 0._wp3261 3262 ! 1. standard boundary treatment3263 ! ------------------------------3264 ! ! East-West boundaries3265 ! !* Cyclic east-west3266 IF( nbondi == 2) THEN3267 IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN3268 ptab( 1 ,:,:) = ptab(jpim1,:,:)3269 ptab(jpi,:,:) = ptab( 2 ,:,:)3270 ELSE3271 IF( .NOT. cd_type == 'F' ) ptab(1:jpreci,:,:) = zland ! south except F-point3272 ptab(nlci-jpreci+1:jpi,:,:) = zland ! north3273 ENDIF3274 ELSEIF(nbondi == -1) THEN3275 IF( .NOT. cd_type == 'F' ) ptab(1:jpreci,:,:) = zland ! south except F-point3276 ELSEIF(nbondi == 1) THEN3277 ptab(nlci-jpreci+1:jpi,:,:) = zland ! north3278 ENDIF !* closed3279 3280 IF (nbondj == 2 .OR. nbondj == -1) THEN3281 IF( .NOT. cd_type == 'F' ) ptab(:,1:jprecj,:) = zland ! south except F-point3282 ELSEIF (nbondj == 2 .OR. nbondj == 1) THEN3283 ptab(:,nlcj-jprecj+1:jpj,:) = zland ! north3284 ENDIF3285 !3286 ! 2. East and west directions exchange3287 ! ------------------------------------3288 ! we play with the neigbours AND the row number because of the periodicity3289 !3290 SELECT CASE ( nbondi_bdy(ib_bdy) ) ! Read Dirichlet lateral conditions3291 CASE ( -1, 0, 1 ) ! all exept 2 (i.e. close case)3292 iihom = nlci-nreci3293 DO jl = 1, jpreci3294 zt3ew(:,jl,:,1) = ptab(jpreci+jl,:,:)3295 zt3we(:,jl,:,1) = ptab(iihom +jl,:,:)3296 END DO3297 END SELECT3298 !3299 ! ! Migrations3300 imigr = jpreci * jpj * jpk3301 !3302 SELECT CASE ( nbondi_bdy(ib_bdy) )3303 CASE ( -1 )3304 CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req1 )3305 CASE ( 0 )3306 CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )3307 CALL mppsend( 2, zt3we(1,1,1,1), imigr, noea, ml_req2 )3308 CASE ( 1 )3309 CALL mppsend( 1, zt3ew(1,1,1,1), imigr, nowe, ml_req1 )3310 END SELECT3311 !3312 SELECT CASE ( nbondi_bdy_b(ib_bdy) )3313 CASE ( -1 )3314 CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )3315 CASE ( 0 )3316 CALL mpprecv( 1, zt3ew(1,1,1,2), imigr, noea )3317 CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )3318 CASE ( 1 )3319 CALL mpprecv( 2, zt3we(1,1,1,2), imigr, nowe )3320 END SELECT3321 !3322 SELECT CASE ( nbondi_bdy(ib_bdy) )3323 CASE ( -1 )3324 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)3325 CASE ( 0 )3326 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)3327 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)3328 CASE ( 1 )3329 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)3330 END SELECT3331 !3332 ! ! Write Dirichlet lateral conditions3333 iihom = nlci-jpreci3334 !3335 SELECT CASE ( nbondi_bdy_b(ib_bdy) )3336 CASE ( -1 )3337 DO jl = 1, jpreci3338 ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2)3339 END DO3340 CASE ( 0 )3341 DO jl = 1, jpreci3342 ptab( jl,:,:) = zt3we(:,jl,:,2)3343 ptab(iihom+jl,:,:) = zt3ew(:,jl,:,2)3344 END DO3345 CASE ( 1 )3346 DO jl = 1, jpreci3347 ptab( jl,:,:) = zt3we(:,jl,:,2)3348 END DO3349 END SELECT3350 3351 3352 ! 3. North and south directions3353 ! -----------------------------3354 ! always closed : we play only with the neigbours3355 !3356 IF( nbondj_bdy(ib_bdy) /= 2 ) THEN ! Read Dirichlet lateral conditions3357 ijhom = nlcj-nrecj3358 DO jl = 1, jprecj3359 zt3sn(:,jl,:,1) = ptab(:,ijhom +jl,:)3360 zt3ns(:,jl,:,1) = ptab(:,jprecj+jl,:)3361 END DO3362 ENDIF3363 !3364 ! ! Migrations3365 imigr = jprecj * jpi * jpk3366 !3367 SELECT CASE ( nbondj_bdy(ib_bdy) )3368 CASE ( -1 )3369 CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req1 )3370 CASE ( 0 )3371 CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )3372 CALL mppsend( 4, zt3sn(1,1,1,1), imigr, nono, ml_req2 )3373 CASE ( 1 )3374 CALL mppsend( 3, zt3ns(1,1,1,1), imigr, noso, ml_req1 )3375 END SELECT3376 !3377 SELECT CASE ( nbondj_bdy_b(ib_bdy) )3378 CASE ( -1 )3379 CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )3380 CASE ( 0 )3381 CALL mpprecv( 3, zt3ns(1,1,1,2), imigr, nono )3382 CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )3383 CASE ( 1 )3384 CALL mpprecv( 4, zt3sn(1,1,1,2), imigr, noso )3385 END SELECT3386 !3387 SELECT CASE ( nbondj_bdy(ib_bdy) )3388 CASE ( -1 )3389 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)3390 CASE ( 0 )3391 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)3392 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)3393 CASE ( 1 )3394 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)3395 END SELECT3396 !3397 ! ! Write Dirichlet lateral conditions3398 ijhom = nlcj-jprecj3399 !3400 SELECT CASE ( nbondj_bdy_b(ib_bdy) )3401 CASE ( -1 )3402 DO jl = 1, jprecj3403 ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2)3404 END DO3405 CASE ( 0 )3406 DO jl = 1, jprecj3407 ptab(:,jl ,:) = zt3sn(:,jl,:,2)3408 ptab(:,ijhom+jl,:) = zt3ns(:,jl,:,2)3409 END DO3410 CASE ( 1 )3411 DO jl = 1, jprecj3412 ptab(:,jl,:) = zt3sn(:,jl,:,2)3413 END DO3414 END SELECT3415 3416 3417 ! 4. north fold treatment3418 ! -----------------------3419 !3420 IF( npolj /= 0) THEN3421 !3422 SELECT CASE ( jpni )3423 CASE ( 1 ) ; CALL lbc_nfd ( ptab, cd_type, psgn ) ! only 1 northern proc, no mpp3424 CASE DEFAULT ; CALL mpp_lbc_north( ptab, cd_type, psgn ) ! for all northern procs.3425 END SELECT3426 !3427 ENDIF3428 !3429 DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we )3430 !3431 END SUBROUTINE mpp_lnk_bdy_3d3432 3433 3434 SUBROUTINE mpp_lnk_bdy_2d( ptab, cd_type, psgn, ib_bdy )3435 !!----------------------------------------------------------------------3436 !! *** routine mpp_lnk_bdy_2d ***3437 !!3438 !! ** Purpose : Message passing management3439 !!3440 !! ** Method : Use mppsend and mpprecv function for passing BDY boundaries3441 !! between processors following neighboring subdomains.3442 !! domain parameters3443 !! nlci : first dimension of the local subdomain3444 !! nlcj : second dimension of the local subdomain3445 !! nbondi_bdy : mark for "east-west local boundary"3446 !! nbondj_bdy : mark for "north-south local boundary"3447 !! noea : number for local neighboring processors3448 !! nowe : number for local neighboring processors3449 !! noso : number for local neighboring processors3450 !! nono : number for local neighboring processors3451 !!3452 !! ** Action : ptab with update value at its periphery3453 !!3454 !!----------------------------------------------------------------------3455 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: ptab ! 3D array on which the boundary condition is applied3456 CHARACTER(len=1) , INTENT(in ) :: cd_type ! define the nature of ptab array grid-points3457 ! ! = T , U , V , F , W points3458 REAL(wp) , INTENT(in ) :: psgn ! =-1 the sign change across the north fold boundary3459 ! ! = 1. , the sign is kept3460 INTEGER , INTENT(in ) :: ib_bdy ! BDY boundary set3461 !3462 INTEGER :: ji, jj, jl ! dummy loop indices3463 INTEGER :: imigr, iihom, ijhom ! local integers3464 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend3465 REAL(wp) :: zland3466 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend3467 !3468 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ns, zt2sn ! 2d for north-south & south-north3469 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zt2ew, zt2we ! 2d for east-west & west-east3470 !!----------------------------------------------------------------------3471 3472 ALLOCATE( zt2ns(jpi,jprecj,2), zt2sn(jpi,jprecj,2), &3473 & zt2ew(jpj,jpreci,2), zt2we(jpj,jpreci,2) )3474 3475 zland = 0._wp3476 3477 ! 1. standard boundary treatment3478 ! ------------------------------3479 ! ! East-West boundaries3480 ! !* Cyclic east-west3481 IF( nbondi == 2 ) THEN3482 IF (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) THEN3483 ptab( 1 ,:) = ptab(jpim1,:)3484 ptab(jpi,:) = ptab( 2 ,:)3485 ELSE3486 IF(.NOT.cd_type == 'F' ) ptab( 1 :jpreci,:) = zland ! south except F-point3487 ptab(nlci-jpreci+1:jpi ,:) = zland ! north3488 ENDIF3489 ELSEIF(nbondi == -1) THEN3490 IF( .NOT.cd_type == 'F' ) ptab( 1 :jpreci,:) = zland ! south except F-point3491 ELSEIF(nbondi == 1) THEN3492 ptab(nlci-jpreci+1:jpi ,:) = zland ! north3493 ENDIF3494 ! !* closed3495 IF( nbondj == 2 .OR. nbondj == -1 ) THEN3496 IF( .NOT.cd_type == 'F' ) ptab(:, 1 :jprecj) = zland ! south except F-point3497 ELSEIF (nbondj == 2 .OR. nbondj == 1) THEN3498 ptab(:,nlcj-jprecj+1:jpj ) = zland ! north3499 ENDIF3500 !3501 ! 2. East and west directions exchange3502 ! ------------------------------------3503 ! we play with the neigbours AND the row number because of the periodicity3504 !3505 SELECT CASE ( nbondi_bdy(ib_bdy) ) ! Read Dirichlet lateral conditions3506 CASE ( -1, 0, 1 ) ! all exept 2 (i.e. close case)3507 iihom = nlci-nreci3508 DO jl = 1, jpreci3509 zt2ew(:,jl,1) = ptab(jpreci+jl,:)3510 zt2we(:,jl,1) = ptab(iihom +jl,:)3511 END DO3512 END SELECT3513 !3514 ! ! Migrations3515 imigr = jpreci * jpj3516 !3517 SELECT CASE ( nbondi_bdy(ib_bdy) )3518 CASE ( -1 )3519 CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req1 )3520 CASE ( 0 )3521 CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )3522 CALL mppsend( 2, zt2we(1,1,1), imigr, noea, ml_req2 )3523 CASE ( 1 )3524 CALL mppsend( 1, zt2ew(1,1,1), imigr, nowe, ml_req1 )3525 END SELECT3526 !3527 SELECT CASE ( nbondi_bdy_b(ib_bdy) )3528 CASE ( -1 )3529 CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )3530 CASE ( 0 )3531 CALL mpprecv( 1, zt2ew(1,1,2), imigr, noea )3532 CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )3533 CASE ( 1 )3534 CALL mpprecv( 2, zt2we(1,1,2), imigr, nowe )3535 END SELECT3536 !3537 SELECT CASE ( nbondi_bdy(ib_bdy) )3538 CASE ( -1 )3539 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)3540 CASE ( 0 )3541 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)3542 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)3543 CASE ( 1 )3544 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)3545 END SELECT3546 !3547 ! ! Write Dirichlet lateral conditions3548 iihom = nlci-jpreci3549 !3550 SELECT CASE ( nbondi_bdy_b(ib_bdy) )3551 CASE ( -1 )3552 DO jl = 1, jpreci3553 ptab(iihom+jl,:) = zt2ew(:,jl,2)3554 END DO3555 CASE ( 0 )3556 DO jl = 1, jpreci3557 ptab(jl ,:) = zt2we(:,jl,2)3558 ptab(iihom+jl,:) = zt2ew(:,jl,2)3559 END DO3560 CASE ( 1 )3561 DO jl = 1, jpreci3562 ptab(jl ,:) = zt2we(:,jl,2)3563 END DO3564 END SELECT3565 3566 3567 ! 3. North and south directions3568 ! -----------------------------3569 ! always closed : we play only with the neigbours3570 !3571 IF( nbondj_bdy(ib_bdy) /= 2 ) THEN ! Read Dirichlet lateral conditions3572 ijhom = nlcj-nrecj3573 DO jl = 1, jprecj3574 zt2sn(:,jl,1) = ptab(:,ijhom +jl)3575 zt2ns(:,jl,1) = ptab(:,jprecj+jl)3576 END DO3577 ENDIF3578 !3579 ! ! Migrations3580 imigr = jprecj * jpi3581 !3582 SELECT CASE ( nbondj_bdy(ib_bdy) )3583 CASE ( -1 )3584 CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req1 )3585 CASE ( 0 )3586 CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )3587 CALL mppsend( 4, zt2sn(1,1,1), imigr, nono, ml_req2 )3588 CASE ( 1 )3589 CALL mppsend( 3, zt2ns(1,1,1), imigr, noso, ml_req1 )3590 END SELECT3591 !3592 SELECT CASE ( nbondj_bdy_b(ib_bdy) )3593 CASE ( -1 )3594 CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )3595 CASE ( 0 )3596 CALL mpprecv( 3, zt2ns(1,1,2), imigr, nono )3597 CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )3598 CASE ( 1 )3599 CALL mpprecv( 4, zt2sn(1,1,2), imigr, noso )3600 END SELECT3601 !3602 SELECT CASE ( nbondj_bdy(ib_bdy) )3603 CASE ( -1 )3604 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)3605 CASE ( 0 )3606 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)3607 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)3608 CASE ( 1 )3609 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)3610 END SELECT3611 !3612 ! ! Write Dirichlet lateral conditions3613 ijhom = nlcj-jprecj3614 !3615 SELECT CASE ( nbondj_bdy_b(ib_bdy) )3616 CASE ( -1 )3617 DO jl = 1, jprecj3618 ptab(:,ijhom+jl) = zt2ns(:,jl,2)3619 END DO3620 CASE ( 0 )3621 DO jl = 1, jprecj3622 ptab(:,jl ) = zt2sn(:,jl,2)3623 ptab(:,ijhom+jl) = zt2ns(:,jl,2)3624 END DO3625 CASE ( 1 )3626 DO jl = 1, jprecj3627 ptab(:,jl) = zt2sn(:,jl,2)3628 END DO3629 END SELECT3630 3631 3632 ! 4. north fold treatment3633 ! -----------------------3634 !3635 IF( npolj /= 0) THEN3636 !3637 SELECT CASE ( jpni )3638 CASE ( 1 ) ; CALL lbc_nfd ( ptab, cd_type, psgn ) ! only 1 northern proc, no mpp3639 CASE DEFAULT ; CALL mpp_lbc_north( ptab, cd_type, psgn ) ! for all northern procs.3640 END SELECT3641 !3642 ENDIF3643 !3644 DEALLOCATE( zt2ns, zt2sn, zt2ew, zt2we )3645 !3646 END SUBROUTINE mpp_lnk_bdy_2d3647 1532 3648 1533 … … 3706 1591 END SUBROUTINE mpi_init_opa 3707 1592 3708 SUBROUTINE DDPDD_MPI (ydda, yddb, ilen, itype) 1593 1594 SUBROUTINE DDPDD_MPI( ydda, yddb, ilen, itype ) 3709 1595 !!--------------------------------------------------------------------- 3710 1596 !! Routine DDPDD_MPI: used by reduction operator MPI_SUMDD … … 3713 1599 !! This subroutine computes yddb(i) = ydda(i)+yddb(i) 3714 1600 !!--------------------------------------------------------------------- 3715 INTEGER , INTENT(in) ::ilen, itype3716 COMPLEX(wp), DIMENSION(ilen), INTENT(in) ::ydda3717 COMPLEX(wp), DIMENSION(ilen), INTENT(inout) ::yddb1601 INTEGER , INTENT(in) :: ilen, itype 1602 COMPLEX(wp), DIMENSION(ilen), INTENT(in) :: ydda 1603 COMPLEX(wp), DIMENSION(ilen), INTENT(inout) :: yddb 3718 1604 ! 3719 1605 REAL(wp) :: zerr, zt1, zt2 ! local work variables 3720 INTEGER :: ji, ztmp ! local scalar 3721 1606 INTEGER :: ji, ztmp ! local scalar 1607 !!--------------------------------------------------------------------- 1608 ! 3722 1609 ztmp = itype ! avoid compilation warning 3723 1610 ! 3724 1611 DO ji=1,ilen 3725 1612 ! Compute ydda + yddb using Knuth's trick. … … 3732 1619 yddb(ji) = cmplx ( zt1 + zt2, zt2 - ((zt1 + zt2) - zt1),wp ) 3733 1620 END DO 3734 1621 ! 3735 1622 END SUBROUTINE DDPDD_MPI 3736 1623 … … 3802 1689 END DO 3803 1690 3804 3805 1691 ! 2. North-Fold boundary conditions 3806 1692 ! ---------------------------------- 3807 CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, pr2dj = ipr2dj )1693 !!gm ERROR CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, pr2dj = ipr2dj ) 3808 1694 3809 1695 ij = ipr2dj … … 3841 1727 !! nono : number for local neighboring processors 3842 1728 !!---------------------------------------------------------------------- 1729 REAL(wp), DIMENSION(1-jpri:jpi+jpri,1-jprj:jpj+jprj), INTENT(inout) :: pt2d ! 2D array with extra halo 1730 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of ptab array grid-points 1731 REAL(wp) , INTENT(in ) :: psgn ! sign used across the north fold 3843 1732 INTEGER , INTENT(in ) :: jpri 3844 1733 INTEGER , INTENT(in ) :: jprj 3845 REAL(wp), DIMENSION(1-jpri:jpi+jpri,1-jprj:jpj+jprj), INTENT(inout) :: pt2d ! 2D array with extra halo 3846 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of ptab array grid-points 3847 ! ! = T , U , V , F , W and I points 3848 REAL(wp) , INTENT(in ) :: psgn ! =-1 the sign change across the 3849 !! ! north boundary, = 1. otherwise 1734 ! 3850 1735 INTEGER :: jl ! dummy loop indices 3851 INTEGER :: imigr, iihom, ijhom ! temporaryintegers3852 INTEGER :: ipreci, iprecj ! temporary integers1736 INTEGER :: imigr, iihom, ijhom ! local integers 1737 INTEGER :: ipreci, iprecj ! - - 3853 1738 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend 3854 1739 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 3855 1740 !! 3856 REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) :: r2dns 3857 REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) :: r2dsn 3858 REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dwe 3859 REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dew 1741 REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) :: r2dns, r2dsn 1742 REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dwe, r2dew 3860 1743 !!---------------------------------------------------------------------- 3861 1744 … … 3875 1758 ! 3876 1759 ELSE !* closed 3877 IF( .NOT. cd_type == 'F' ) pt2d( 1-jpri :jpreci ,:) = 0. e0! south except at F-point3878 pt2d(nlci-jpreci+1:jpi+jpri,:) = 0. e0! north1760 IF( .NOT. cd_type == 'F' ) pt2d( 1-jpri :jpreci ,:) = 0._wp ! south except at F-point 1761 pt2d(nlci-jpreci+1:jpi+jpri,:) = 0._wp ! north 3879 1762 ENDIF 3880 1763 ! … … 3885 1768 ! 3886 1769 SELECT CASE ( jpni ) 3887 CASE ( 1 ) ; CALL lbc_nfd ( pt2d(1:jpi,1:jpj+jprj), cd_type, psgn, pr2dj=jprj )3888 CASE DEFAULT ; CALL mpp_lbc_north_icb( pt2d(1:jpi,1:jpj+jprj) , cd_type, psgn , pr2dj=jprj )1770 !!gm ERROR CASE ( 1 ) ; CALL lbc_nfd ( pt2d(1:jpi,1:jpj+jprj), cd_type, psgn, pr2dj=jprj ) 1771 !!gm ERROR CASE DEFAULT ; CALL mpp_lbc_north_icb( pt2d(1:jpi,1:jpj+jprj) , cd_type, psgn , pr2dj=jprj ) 3889 1772 END SELECT 3890 1773 ! … … 3996 1879 END DO 3997 1880 END SELECT 3998 1881 ! 3999 1882 END SUBROUTINE mpp_lnk_2d_icb 4000 1883 … … 4020 1903 MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d 4021 1904 END INTERFACE 1905 INTERFACE mpp_max_multiple 1906 MODULE PROCEDURE mppmax_real_multiple 1907 END INTERFACE 4022 1908 4023 1909 LOGICAL, PUBLIC, PARAMETER :: lk_mpp = .FALSE. !: mpp flag … … 4191 2077 WRITE(*,*) 'mpp_comm_free: You should not have seen this print! error?', kcom 4192 2078 END SUBROUTINE mpp_comm_free 2079 2080 SUBROUTINE mppmax_real_multiple( ptab, kdim , kcom ) 2081 REAL, DIMENSION(:) :: ptab ! 2082 INTEGER :: kdim ! 2083 INTEGER, OPTIONAL :: kcom ! 2084 WRITE(*,*) 'mppmax_real_multiple: You should not have seen this print! error?', ptab(1), kdim 2085 END SUBROUTINE mppmax_real_multiple 2086 4193 2087 #endif 4194 2088 … … 4225 2119 CALL FLUSH(numout ) 4226 2120 IF( numstp /= -1 ) CALL FLUSH(numstp ) 4227 IF( num sol /= -1 ) CALL FLUSH(numsol)2121 IF( numrun /= -1 ) CALL FLUSH(numrun ) 4228 2122 IF( numevo_ice /= -1 ) CALL FLUSH(numevo_ice) 4229 2123 ! … … 4332 2226 WRITE(kout,*) 4333 2227 ENDIF 4334 CALL FLUSH( kout)2228 CALL FLUSH( kout ) 4335 2229 STOP 'ctl_opn bad opening' 4336 2230 ENDIF -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90
r8733 r8738 291 291 END DO 292 292 ENDIF 293 #if defined key_lim 2 || defined key_lim3293 #if defined key_lim3 294 294 IF (ln_sic) THEN 295 295 jtype = jtype + 1 … … 539 539 #if defined key_lim3 540 540 USE ice, ONLY : & ! LIM3 Ice model variables 541 & frld 542 #endif 543 #if defined key_lim2 544 USE ice_2, ONLY : & ! LIM2 Ice model variables 545 & frld 541 & at_i 546 542 #endif 547 543 IMPLICIT NONE … … 567 563 & zgphi1, & ! Model latitudes for prof variable 1 568 564 & zgphi2 ! Model latitudes for prof variable 2 569 #if ! defined key_lim 2 && ! defined key_lim3570 REAL(wp), POINTER, DIMENSION(:,:) :: frld565 #if ! defined key_lim3 566 REAL(wp), POINTER, DIMENSION(:,:) :: at_i 571 567 #endif 572 568 LOGICAL :: llnightav ! Logical for calculating night-time average … … 582 578 CALL wrk_alloc( jpi, jpj, zgphi1 ) 583 579 CALL wrk_alloc( jpi, jpj, zgphi2 ) 584 #if ! defined key_lim 2 && ! defined key_lim3585 CALL wrk_alloc(jpi,jpj, frld)580 #if ! defined key_lim3 581 CALL wrk_alloc(jpi,jpj,at_i) 586 582 #endif 587 583 … … 595 591 596 592 !----------------------------------------------------------------------- 597 ! No LIM => frld== 0.0_wp598 !----------------------------------------------------------------------- 599 #if ! defined key_lim 2 && ! defined key_lim3600 frld(:,:) = 0.0_wp593 ! No LIM => at_i == 0.0_wp 594 !----------------------------------------------------------------------- 595 #if ! defined key_lim3 596 at_i(:,:) = 0.0_wp 601 597 #endif 602 598 !----------------------------------------------------------------------- … … 665 661 zsurfvar(:,:) = sshn(:,:) 666 662 llnightav = .FALSE. 667 #if defined key_lim 2 || defined key_lim3663 #if defined key_lim3 668 664 CASE('sic') 669 665 IF ( kstp == 0 ) THEN … … 678 674 CYCLE 679 675 ELSE 680 zsurfvar(:,:) = 1._wp - frld(:,:)676 zsurfvar(:,:) = at_i(:,:) 681 677 ENDIF 682 678 … … 702 698 CALL wrk_dealloc( jpi, jpj, zgphi1 ) 703 699 CALL wrk_dealloc( jpi, jpj, zgphi2 ) 704 #if ! defined key_lim 2 && ! defined key_lim3705 CALL wrk_dealloc(jpi,jpj, frld)700 #if ! defined key_lim3 701 CALL wrk_dealloc(jpi,jpj,at_i) 706 702 #endif 707 703 -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
r8733 r8738 116 116 END TYPE WGT 117 117 118 INTEGER, PARAMETER :: tot_wgts = 10118 INTEGER, PARAMETER :: tot_wgts = 20 119 119 TYPE( WGT ), DIMENSION(tot_wgts) :: ref_wgts ! array of wgts 120 120 INTEGER :: nxt_wgt = 1 ! point to next available space in ref_wgts array -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90
r8733 r8738 9 9 !! 3.4 ! 2011-11 (C. Harris) CICE added as an option 10 10 !!---------------------------------------------------------------------- 11 #if defined key_lim3 || defined key_ lim2 || defined key_cice12 !!---------------------------------------------------------------------- 13 !! 'key_lim 2' or 'key_lim3' : LIM-2 orLIM-3 sea-ice model11 #if defined key_lim3 || defined key_cice 12 !!---------------------------------------------------------------------- 13 !! 'key_lim3' : LIM-3 sea-ice model 14 14 !!---------------------------------------------------------------------- 15 15 USE par_oce ! ocean parameters … … 18 18 USE ice ! LIM-3 parameters 19 19 # endif 20 # if defined key_lim221 USE par_ice_2 ! LIM-2 parameters22 USE ice_223 # endif24 20 # if defined key_cice 25 21 USE ice_domain_size, only: ncat … … 31 27 PRIVATE 32 28 33 PUBLIC sbc_ice_alloc ! called in iceini(_2).F90 34 35 # if defined key_lim2 36 LOGICAL , PUBLIC, PARAMETER :: lk_lim2 = .TRUE. !: LIM-2 ice model 37 LOGICAL , PUBLIC, PARAMETER :: lk_lim3 = .FALSE. !: no LIM-3 38 LOGICAL , PUBLIC, PARAMETER :: lk_cice = .FALSE. !: no CICE 39 # if defined key_lim2_vp 40 CHARACTER(len=1), PUBLIC, PARAMETER :: cp_ice_msh = 'I' !: VP : 'I'-grid ice-velocity (B-grid lower left corner) 41 # else 42 CHARACTER(len=1), PUBLIC, PARAMETER :: cp_ice_msh = 'C' !: EVP: 'C'-grid ice-velocity 43 # endif 44 # endif 29 PUBLIC sbc_ice_alloc ! called in sbcmod.F90 30 45 31 # if defined key_lim3 46 LOGICAL , PUBLIC, PARAMETER :: lk_lim2 = .FALSE. !: no LIM-247 32 LOGICAL , PUBLIC, PARAMETER :: lk_lim3 = .TRUE. !: LIM-3 ice model 48 33 LOGICAL , PUBLIC, PARAMETER :: lk_cice = .FALSE. !: no CICE … … 50 35 # endif 51 36 # if defined key_cice 52 LOGICAL , PUBLIC, PARAMETER :: lk_lim2 = .FALSE. !: no LIM-253 37 LOGICAL , PUBLIC, PARAMETER :: lk_lim3 = .FALSE. !: no LIM-3 54 38 LOGICAL , PUBLIC, PARAMETER :: lk_cice = .TRUE. !: CICE ice model … … 83 67 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qprec_ice !: enthalpy of precip over ice [J/m3] 84 68 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_oce !: evap - precip over ocean [kg/m2/s] 85 #endif86 #if defined key_lim3 || defined key_lim287 69 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: wndm_ice !: wind speed module at T-point [m/s] 88 70 #endif … … 106 88 INTEGER , PUBLIC, PARAMETER :: jpl = ncat 107 89 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice ! jpi, jpj 108 #endif109 90 110 #if defined key_lim2 || defined key_cice111 91 ! already defined in ice.F90 for LIM3 112 92 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_i 113 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ht_i, ht_s 114 #endif 115 116 #if defined key_cice 93 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: h_i, h_s 94 117 95 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tatm_ice !: air temperature [K] 118 96 #endif 119 97 120 98 REAL(wp), PUBLIC, SAVE :: cldf_ice = 0.81 !: cloud fraction over sea ice, summer CLIO value [-] 99 100 !! arrays relating to embedding ice in the ocean 101 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: snwice_mass !: mass of snow and ice at current ice time step [Kg/m2] 102 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: snwice_mass_b !: mass of snow and ice at previous ice time step [Kg/m2] 103 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: snwice_fmass !: time evolution of mass of snow+ice [Kg/m2/s] 121 104 122 105 !!---------------------------------------------------------------------- … … 131 114 !! *** FUNCTION sbc_ice_alloc *** 132 115 !!---------------------------------------------------------------------- 133 INTEGER :: ierr( 5)116 INTEGER :: ierr(4) 134 117 !!---------------------------------------------------------------------- 135 118 ierr(:) = 0 136 119 137 #if defined key_lim3 || defined key_lim2 120 ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), snwice_fmass(jpi,jpj) , STAT=ierr(1) ) 121 122 #if defined key_lim3 138 123 ALLOCATE( qns_ice (jpi,jpj,jpl) , qsr_ice (jpi,jpj,jpl) , & 139 124 & qla_ice (jpi,jpj,jpl) , dqla_ice(jpi,jpj,jpl) , & … … 141 126 & utau_ice(jpi,jpj) , vtau_ice(jpi,jpj) , wndm_ice(jpi,jpj) , & 142 127 & fr1_i0 (jpi,jpj) , fr2_i0 (jpi,jpj) , & 143 #if defined key_lim2144 & a_i(jpi,jpj,jpl) , &145 #endif146 #if defined key_lim3147 128 & evap_ice(jpi,jpj,jpl) , devap_ice(jpi,jpj,jpl) , qprec_ice(jpi,jpj) , & 148 129 & qemp_ice(jpi,jpj) , qevap_ice(jpi,jpj,jpl) , qemp_oce (jpi,jpj) , & 149 130 & qns_oce (jpi,jpj) , qsr_oce (jpi,jpj) , emp_oce (jpi,jpj) , & 150 #endif 151 & emp_ice(jpi,jpj) , STAT= ierr(1) ) 131 & emp_ice(jpi,jpj) , STAT= ierr(2) ) 152 132 #endif 153 133 … … 158 138 ss_iov(jpi,jpj) , fr_iu(jpi,jpj) , fr_iv(jpi,jpj) , & 159 139 a_i(jpi,jpj,ncat) , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat) , & 160 STAT= ierr( 1) )140 STAT= ierr(2) ) 161 141 IF( ln_cpl ) ALLOCATE( u_ice(jpi,jpj) , fr1_i0(jpi,jpj) , tn_ice (jpi,jpj,1) , & 162 142 & v_ice(jpi,jpj) , fr2_i0(jpi,jpj) , alb_ice(jpi,jpj,1) , & 163 143 & emp_ice(jpi,jpj) , qns_ice(jpi,jpj,1) , dqns_ice(jpi,jpj,1) , & 164 & STAT= ierr(2) ) 165 166 #endif 167 ! 168 #if defined key_cice || defined key_lim2 169 IF( ln_cpl ) ALLOCATE( ht_i(jpi,jpj,jpl) , ht_s(jpi,jpj,jpl) , STAT=ierr(5) ) 144 & STAT= ierr(3) ) 145 IF( ln_cpl ) ALLOCATE( h_i(jpi,jpj,jpl) , h_s(jpi,jpj,jpl) , STAT=ierr(4) ) 170 146 #endif 171 147 … … 177 153 #else 178 154 !!---------------------------------------------------------------------- 179 !! Default option NO LIM 2.0 or 3.0 or CICE sea-ice model 180 !!---------------------------------------------------------------------- 155 !! Default option NO LIM3 or CICE sea-ice model 156 !!---------------------------------------------------------------------- 157 USE lib_mpp ! MPP library 181 158 USE in_out_manager ! I/O manager 182 LOGICAL , PUBLIC, PARAMETER :: lk_lim2 = .FALSE. !: no LIM-2 ice model 159 160 IMPLICIT NONE 161 PRIVATE 162 163 PUBLIC sbc_ice_alloc 164 183 165 LOGICAL , PUBLIC, PARAMETER :: lk_lim3 = .FALSE. !: no LIM-3 ice model 184 166 LOGICAL , PUBLIC, PARAMETER :: lk_cice = .FALSE. !: no CICE ice model … … 191 173 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_ice 192 174 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: qsr_ice 193 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: h t_i, ht_s175 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: h_i, h_s 194 176 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: topmelt, botmelt 177 ! 178 !! arrays relating to embedding ice in the ocean. These arrays need to be declared 179 !! even if no ice model is required. In the no ice model or traditional levitating 180 !! ice cases they contain only zeros 181 !! --------------------- 182 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: snwice_mass !: mass of snow and ice at current ice time step [Kg/m2] 183 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: snwice_mass_b !: mass of snow and ice at previous ice time step [Kg/m2] 184 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: snwice_fmass !: time evolution of mass of snow+ice [Kg/m2/s] 185 186 CONTAINS 187 INTEGER FUNCTION sbc_ice_alloc() 188 !!---------------------------------------------------------------------- 189 !! *** FUNCTION sbc_ice_alloc *** 190 !!---------------------------------------------------------------------- 191 INTEGER :: ierr(1) 192 !!---------------------------------------------------------------------- 193 ierr(:) = 0 194 ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), snwice_fmass(jpi,jpj) , STAT=ierr(1) ) 195 sbc_ice_alloc = MAXVAL( ierr ) 196 IF( lk_mpp ) CALL mpp_sum ( sbc_ice_alloc ) 197 IF( sbc_ice_alloc > 0 ) CALL ctl_warn('sbc_ice_alloc: allocation of arrays failed') 198 END FUNCTION sbc_ice_alloc 195 199 #endif 196 200 -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
r8733 r8738 47 47 LOGICAL , PUBLIC :: ln_apr_dyn !: Atmospheric pressure forcing used on dynamics (ocean & ice) 48 48 INTEGER , PUBLIC :: nn_ice !: flag for ice in the surface boundary condition (=0/1/2/3) 49 INTEGER , PUBLIC :: nn_ice_embd !: flag for levitating/embedding sea-ice in the ocean 50 ! !: =0 levitating ice (no mass exchange, concentration/dilution effect) 51 ! !: =1 levitating ice with mass and salt exchange but no presure effect 52 ! !: =2 embedded sea-ice (full salt and mass exchanges and pressure) 49 LOGICAL , PUBLIC :: ln_ice_embd !: flag for levitating/embedding sea-ice in the ocean 50 ! !: =F levitating ice with mass and salt exchange but no presure effect 51 ! !: =T embedded sea-ice (full salt and mass exchanges and pressure) 53 52 INTEGER , PUBLIC :: nn_components !: flag for sbc module (including sea-ice) coupling mode (see component definition below) 54 INTEGER , PUBLIC :: nn_limflx !: LIM3 Multi-category heat flux formulation55 ! !: =-1 Use of per-category fluxes56 ! !: = 0 Average per-category fluxes57 ! !: = 1 Average then redistribute per-category fluxes58 ! !: = 2 Redistribute a single flux over categories59 53 INTEGER , PUBLIC :: nn_fwb !: FreshWater Budget: 60 54 ! !: = 0 unchecked -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk.F90
r8733 r8738 40 40 USE lib_fortran ! to use key_nosignedzero 41 41 #if defined key_lim3 42 USE ice , ONLY : u_ice, v_ice, jpl, pfrld, a_i_b, at_i_b 43 USE limthd_dh ! for CALL lim_thd_snwblow 44 #elif defined key_lim2 45 USE ice_2 , ONLY : u_ice, v_ice 46 USE par_ice_2 ! LIM-2 parameters 42 USE ice , ONLY : u_ice, v_ice, jpl, a_i_b, at_i_b, tm_su 43 USE icethd_dh ! for CALL ice_thd_snwblow 47 44 #endif 48 45 USE sbcblk_algo_ncar ! => turb_ncar : NCAR - CORE (Large & Yeager, 2009) … … 64 61 PUBLIC sbc_blk_init ! called in sbcmod 65 62 PUBLIC sbc_blk ! called in sbcmod 66 #if defined key_lim 2 || defined key_lim367 PUBLIC blk_ice_tau ! routine called in sbc_ice_limmodule68 PUBLIC blk_ice_flx ! routine called in sbc_ice_limmodule63 #if defined key_lim3 64 PUBLIC blk_ice_tau ! routine called in icestp module 65 PUBLIC blk_ice_flx ! routine called in icestp module 69 66 #endif 70 67 … … 96 93 REAL(wp), PARAMETER :: Ls = 2.839e6 ! latent heat of sublimation 97 94 REAL(wp), PARAMETER :: Stef = 5.67e-8 ! Stefan Boltzmann constant 98 REAL(wp), PARAMETER :: Cd_ice = 1.4e-3 ! iovi 1.63e-3 !transfer coefficient over ice95 REAL(wp), PARAMETER :: Cd_ice = 1.4e-3 ! transfer coefficient over ice 99 96 REAL(wp), PARAMETER :: albo = 0.066 ! ocean albedo assumed to be constant 100 97 ! … … 111 108 REAL(wp) :: rn_zqt ! z(q,t) : height of humidity and temperature measurements 112 109 REAL(wp) :: rn_zu ! z(u) : height of wind measurements 113 LOGICAL :: ln_Cd_L12 = .FALSE. ! Modify the drag ice-atm and oce-atm depending on ice concentration (from Lupkes et al. JGR2012) 110 LOGICAL :: ln_Cd_L12 = .FALSE. ! Modify the drag ice-atm depending on ice concentration (from Lupkes et al. JGR2012) 111 LOGICAL :: ln_Cd_L15 = .FALSE. ! Modify the drag ice-atm depending on ice concentration (from Lupkes et al. JGR2015) 114 112 ! 115 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: Cd_oce ! air-ocean drag (clem) 113 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: Cd_atm ! transfer coefficient for momentum (tau) 114 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: Ch_atm ! transfer coefficient for sensible heat (Q_sens) 115 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: Ce_atm ! tansfert coefficient for evaporation (Q_lat) 116 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_zu ! air temperature at wind speed height (needed by Lupkes 2015 bulk scheme) 117 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: q_zu ! air spec. hum. at wind speed height (needed by Lupkes 2015 bulk scheme) 118 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: cdn_oce, chn_oce, cen_oce ! needed by Lupkes 2015 bulk scheme 116 119 117 120 INTEGER :: nblk ! choice of the bulk algorithm … … 135 138 !! *** ROUTINE sbc_blk_alloc *** 136 139 !!------------------------------------------------------------------- 137 ALLOCATE( Cd_oce(jpi,jpj) , STAT=sbc_blk_alloc ) 140 ALLOCATE( Cd_atm (jpi,jpj), Ch_atm (jpi,jpj), Ce_atm (jpi,jpj), t_zu(jpi,jpj), q_zu(jpi,jpj), & 141 & cdn_oce(jpi,jpj), chn_oce(jpi,jpj), cen_oce(jpi,jpj), STAT=sbc_blk_alloc ) 138 142 ! 139 143 IF( lk_mpp ) CALL mpp_sum ( sbc_blk_alloc ) … … 167 171 & ln_NCAR, ln_COARE_3p0, ln_COARE_3p5, ln_ECMWF, & ! bulk algorithm 168 172 & cn_dir , ln_taudif, rn_zqt, rn_zu, & 169 & rn_pfac, rn_efac, rn_vfac, ln_Cd_L12 173 & rn_pfac, rn_efac, rn_vfac, ln_Cd_L12, ln_Cd_L15 170 174 !!--------------------------------------------------------------------- 171 175 ! … … 258 262 WRITE(numout,*) ' factor applied on ocean/ice velocity rn_vfac = ', rn_vfac 259 263 WRITE(numout,*) ' (form absolute (=0) to relative winds(=1))' 264 WRITE(numout,*) ' use ice-atm drag from Lupkes2012 ln_Cd_L12 = ', ln_Cd_L12 265 WRITE(numout,*) ' use ice-atm drag from Lupkes2015 ln_Cd_L15 = ', ln_Cd_L15 260 266 ! 261 267 WRITE(numout,*) … … 364 370 REAL(wp), DIMENSION(:,:), POINTER :: zqlw, zqsb ! long wave and sensible heat fluxes 365 371 REAL(wp), DIMENSION(:,:), POINTER :: zqla, zevap ! latent heat fluxes and evaporation 366 REAL(wp), DIMENSION(:,:), POINTER :: Cd ! transfer coefficient for momentum (tau)367 REAL(wp), DIMENSION(:,:), POINTER :: Ch ! transfer coefficient for sensible heat (Q_sens)368 REAL(wp), DIMENSION(:,:), POINTER :: Ce ! tansfert coefficient for evaporation (Q_lat)369 372 REAL(wp), DIMENSION(:,:), POINTER :: zst ! surface temperature in Kelvin 370 REAL(wp), DIMENSION(:,:), POINTER :: zt_zu ! air temperature at wind speed height371 REAL(wp), DIMENSION(:,:), POINTER :: zq_zu ! air spec. hum. at wind speed height372 373 REAL(wp), DIMENSION(:,:), POINTER :: zU_zu ! bulk wind speed at height zu [m/s] 373 374 REAL(wp), DIMENSION(:,:), POINTER :: ztpot ! potential temperature of air at z=rn_zqt [K] … … 378 379 ! 379 380 CALL wrk_alloc( jpi,jpj, zwnd_i, zwnd_j, zsq, zqlw, zqsb, zqla, zevap ) 380 CALL wrk_alloc( jpi,jpj, Cd, Ch, Ce, zst, zt_zu, zq_zu ) 381 CALL wrk_alloc( jpi,jpj, zU_zu, ztpot, zrhoa ) 381 CALL wrk_alloc( jpi,jpj, zst, zU_zu, ztpot, zrhoa ) 382 382 ! 383 383 … … 426 426 zqlw(:,:) = ( sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:) ) * tmask(:,:,1) ! Long Wave 427 427 428 429 430 428 ! ----------------------------------------------------------------------------- ! 431 429 ! II Turbulent FLUXES ! … … 443 441 ! 444 442 CASE( np_NCAR ) ; CALL turb_ncar ( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm, & ! NCAR-COREv2 445 & Cd, Ch, Ce, zt_zu, zq_zu, zU_zu)443 & Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce ) 446 444 CASE( np_COARE_3p0 ) ; CALL turb_coare ( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm, & ! COARE v3.0 447 & Cd, Ch, Ce, zt_zu, zq_zu, zU_zu)445 & Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce ) 448 446 CASE( np_COARE_3p5 ) ; CALL turb_coare3p5( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm, & ! COARE v3.5 449 & Cd, Ch, Ce, zt_zu, zq_zu, zU_zu)447 & Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce ) 450 448 CASE( np_ECMWF ) ; CALL turb_ecmwf ( rn_zqt, rn_zu, zst, ztpot, zsq, sf(jp_humi)%fnow, wndm, & ! ECMWF 451 & Cd, Ch, Ce, zt_zu, zq_zu, zU_zu)449 & Cd_atm, Ch_atm, Ce_atm, t_zu, q_zu, zU_zu, cdn_oce, chn_oce, cen_oce ) 452 450 CASE DEFAULT 453 451 CALL ctl_stop( 'STOP', 'sbc_oce: non-existing bulk formula selected' ) … … 456 454 ! ! Compute true air density : 457 455 IF( ABS(rn_zu - rn_zqt) > 0.01 ) THEN ! At zu: (probably useless to remove zrho*grav*rn_zu from SLP...) 458 zrhoa(:,:) = rho_air( zt_zu(:,:) , zq_zu(:,:), sf(jp_slp)%fnow(:,:,1) )456 zrhoa(:,:) = rho_air( t_zu(:,:) , q_zu(:,:) , sf(jp_slp)%fnow(:,:,1) ) 459 457 ELSE ! At zt: 460 458 zrhoa(:,:) = rho_air( sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1) ) 461 459 END IF 462 460 463 Cd_oce(:,:) = Cd(:,:) ! record value of pure ocean-atm. drag (clem) 461 !! CALL iom_put( "Cd_oce", Cd_atm) ! output value of pure ocean-atm. transfer coef. 462 !! CALL iom_put( "Ch_oce", Ch_atm) ! output value of pure ocean-atm. transfer coef. 464 463 465 464 DO jj = 1, jpj ! tau module, i and j component 466 465 DO ji = 1, jpi 467 zztmp = zrhoa(ji,jj) * zU_zu(ji,jj) * Cd (ji,jj) ! using bulk wind speed466 zztmp = zrhoa(ji,jj) * zU_zu(ji,jj) * Cd_atm(ji,jj) ! using bulk wind speed 468 467 taum (ji,jj) = zztmp * wndm (ji,jj) 469 468 zwnd_i(ji,jj) = zztmp * zwnd_i(ji,jj) … … 500 499 IF( ABS( rn_zu - rn_zqt) < 0.01_wp ) THEN 501 500 !! q_air and t_air are given at 10m (wind reference height) 502 zevap(:,:) = rn_efac*MAX( 0._wp, zqla(:,:)*Ce (:,:)*(zsq(:,:) - sf(jp_humi)%fnow(:,:,1)) ) ! Evaporation, using bulk wind speed503 zqsb (:,:) = cp_air(sf(jp_humi)%fnow(:,:,1))*zqla(:,:)*Ch (:,:)*(zst(:,:) - ztpot(:,:) ) ! Sensible Heat, using bulk wind speed501 zevap(:,:) = rn_efac*MAX( 0._wp, zqla(:,:)*Ce_atm(:,:)*(zsq(:,:) - sf(jp_humi)%fnow(:,:,1)) ) ! Evaporation, using bulk wind speed 502 zqsb (:,:) = cp_air(sf(jp_humi)%fnow(:,:,1))*zqla(:,:)*Ch_atm(:,:)*(zst(:,:) - ztpot(:,:) ) ! Sensible Heat, using bulk wind speed 504 503 ELSE 505 504 !! q_air and t_air are not given at 10m (wind reference height) 506 505 ! Values of temp. and hum. adjusted to height of wind during bulk algorithm iteration must be used!!! 507 zevap(:,:) = rn_efac*MAX( 0._wp, zqla(:,:)*Ce (:,:)*(zsq(:,:) - zq_zu(:,:) ) ) ! Evaporation !using bulk wind speed508 zqsb (:,:) = cp_air(sf(jp_humi)%fnow(:,:,1))*zqla(:,:)*Ch (:,:)*(zst(:,:) - zt_zu(:,:) ) ! Sensible Heat !using bulk wind speed506 zevap(:,:) = rn_efac*MAX( 0._wp, zqla(:,:)*Ce_atm(:,:)*(zsq(:,:) - q_zu(:,:) ) ) ! Evaporation, using bulk wind speed 507 zqsb (:,:) = cp_air(sf(jp_humi)%fnow(:,:,1))*zqla(:,:)*Ch_atm(:,:)*(zst(:,:) - t_zu(:,:) ) ! Sensible Heat, using bulk wind speed 509 508 ENDIF 510 509 … … 513 512 514 513 IF(ln_ctl) THEN 515 CALL prt_ctl( tab2d_1=zqla , clinfo1=' blk_oce: zqla : ', tab2d_2=Ce , clinfo2=' Ce : ' )516 CALL prt_ctl( tab2d_1=zqsb , clinfo1=' blk_oce: zqsb : ', tab2d_2=Ch , clinfo2=' Ch: ' )514 CALL prt_ctl( tab2d_1=zqla , clinfo1=' blk_oce: zqla : ', tab2d_2=Ce_atm , clinfo2=' Ce_oce : ' ) 515 CALL prt_ctl( tab2d_1=zqsb , clinfo1=' blk_oce: zqsb : ', tab2d_2=Ch_atm , clinfo2=' Ch_oce : ' ) 517 516 CALL prt_ctl( tab2d_1=zqlw , clinfo1=' blk_oce: zqlw : ', tab2d_2=qsr, clinfo2=' qsr : ' ) 518 517 CALL prt_ctl( tab2d_1=zsq , clinfo1=' blk_oce: zsq : ', tab2d_2=zst, clinfo2=' zst : ' ) … … 566 565 ! 567 566 CALL wrk_dealloc( jpi,jpj, zwnd_i, zwnd_j, zsq, zqlw, zqsb, zqla, zevap ) 568 CALL wrk_dealloc( jpi,jpj, Cd, Ch, Ce, zst, zt_zu, zq_zu ) 569 CALL wrk_dealloc( jpi,jpj, zU_zu, ztpot, zrhoa ) 567 CALL wrk_dealloc( jpi,jpj, zst, zU_zu, ztpot, zrhoa ) 570 568 ! 571 569 IF( nn_timing == 1 ) CALL timing_stop('blk_oce') … … 573 571 END SUBROUTINE blk_oce 574 572 575 #if defined key_lim 2 || defined key_lim3573 #if defined key_lim3 576 574 577 575 SUBROUTINE blk_ice_tau … … 591 589 REAL(wp) :: zwnorm_f, zwndi_f , zwndj_f ! relative wind module and components at F-point 592 590 REAL(wp) :: zwndi_t , zwndj_t ! relative wind components at T-point 593 REAL(wp), DIMENSION(:,:), POINTER :: Cd ! transfer coefficient for momentum (tau)594 591 !!--------------------------------------------------------------------- 595 592 ! … … 597 594 ! 598 595 CALL wrk_alloc( jpi,jpj, zrhoa ) 599 CALL wrk_alloc( jpi,jpj, Cd ) 600 601 Cd(:,:) = Cd_ice 602 603 ! Make ice-atm. drag dependent on ice concentration (see Lupkes et al. 2012) (clem) 604 #if defined key_lim3 605 IF( ln_Cd_L12 ) THEN 606 CALL Cdn10_Lupkes2012( Cd ) ! calculate new drag from Lupkes(2012) equations 607 ENDIF 608 #endif 609 610 ! local scalars ( place there for vector optimisation purposes) 611 ! Computing density of air! Way denser that 1.2 over sea-ice !!! 612 !! 613 zrhoa (:,:) = rho_air(sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1)) 614 615 !!gm brutal.... 616 utau_ice (:,:) = 0._wp 617 vtau_ice (:,:) = 0._wp 618 wndm_ice (:,:) = 0._wp 619 !!gm end 620 621 ! ----------------------------------------------------------------------------- ! 622 ! Wind components and module relative to the moving ocean ( U10m - U_ice ) ! 623 ! ----------------------------------------------------------------------------- ! 596 597 ! set transfer coefficients to default sea-ice values 598 Cd_atm(:,:) = Cd_ice 599 Ch_atm(:,:) = Cd_ice 600 Ce_atm(:,:) = Cd_ice 601 602 wndm_ice(:,:) = 0._wp !!gm brutal.... 603 604 ! ------------------------------------------------------------ ! 605 ! Wind module relative to the moving ice ( U10m - U_ice ) ! 606 ! ------------------------------------------------------------ ! 624 607 SELECT CASE( cp_ice_msh ) 625 608 CASE( 'I' ) ! B-grid ice dynamics : I-point (i.e. F-point with sea-ice indexation) … … 627 610 DO jj = 2, jpjm1 628 611 DO ji = 2, jpim1 ! B grid : NO vector opt 629 ! ... scalar wind at I-point (fld being at T-point)630 zwndi_f = 0.25 * ( sf(jp_wndi)%fnow(ji-1,jj ,1) + sf(jp_wndi)%fnow(ji ,jj ,1) &631 & + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji ,jj-1,1) ) - rn_vfac * u_ice(ji,jj)632 zwndj_f = 0.25 * ( sf(jp_wndj)%fnow(ji-1,jj ,1) + sf(jp_wndj)%fnow(ji ,jj ,1) &633 & + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji ,jj-1,1) ) - rn_vfac * v_ice(ji,jj)634 zwnorm_f = zrhoa(ji,jj) * Cd(ji,jj) * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f )635 ! ... ice stress at I-point636 utau_ice(ji,jj) = zwnorm_f * zwndi_f637 vtau_ice(ji,jj) = zwnorm_f * zwndj_f638 612 ! ... scalar wind at T-point (fld being at T-point) 639 613 zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.25 * ( u_ice(ji,jj+1) + u_ice(ji+1,jj+1) & … … 644 618 END DO 645 619 END DO 646 CALL lbc_lnk( utau_ice, 'I', -1. )647 CALL lbc_lnk( vtau_ice, 'I', -1. )648 620 CALL lbc_lnk( wndm_ice, 'T', 1. ) 649 621 ! 650 622 CASE( 'C' ) ! C-grid ice dynamics : U & V-points (same as ocean) 651 DO jj = 2, jpj 652 DO ji = fs_2, jpi! vect. opt.623 DO jj = 2, jpjm1 624 DO ji = fs_2, fs_jpim1 ! vect. opt. 653 625 zwndi_t = ( sf(jp_wndi)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( u_ice(ji-1,jj ) + u_ice(ji,jj) ) ) 654 626 zwndj_t = ( sf(jp_wndj)%fnow(ji,jj,1) - rn_vfac * 0.5 * ( v_ice(ji ,jj-1) + v_ice(ji,jj) ) ) … … 656 628 END DO 657 629 END DO 630 CALL lbc_lnk( wndm_ice, 'T', 1. ) 631 ! 632 END SELECT 633 634 ! Make ice-atm. drag dependent on ice concentration 635 IF ( ln_Cd_L12 ) THEN ! calculate new drag from Lupkes(2012) equations 636 CALL Cdn10_Lupkes2012( Cd_atm ) 637 Ch_atm(:,:) = Cd_atm(:,:) ! momentum and heat transfer coef. are considered identical 638 ELSEIF( ln_Cd_L15 ) THEN ! calculate new drag from Lupkes(2015) equations 639 CALL Cdn10_Lupkes2015( Cd_atm, Ch_atm ) 640 ENDIF 641 642 !! CALL iom_put( "Cd_ice", Cd_atm) ! output value of pure ice-atm. transfer coef. 643 !! CALL iom_put( "Ch_ice", Ch_atm) ! output value of pure ice-atm. transfer coef. 644 645 ! local scalars ( place there for vector optimisation purposes) 646 ! Computing density of air! Way denser that 1.2 over sea-ice !!! 647 zrhoa (:,:) = rho_air(sf(jp_tair)%fnow(:,:,1), sf(jp_humi)%fnow(:,:,1), sf(jp_slp)%fnow(:,:,1)) 648 649 !!gm brutal.... 650 utau_ice (:,:) = 0._wp 651 vtau_ice (:,:) = 0._wp 652 !!gm end 653 654 ! ------------------------------------------------------------ ! 655 ! Wind stress relative to the moving ice ( U10m - U_ice ) ! 656 ! ------------------------------------------------------------ ! 657 SELECT CASE( cp_ice_msh ) 658 CASE( 'I' ) ! B-grid ice dynamics : I-point (i.e. F-point with sea-ice indexation) 659 DO jj = 2, jpjm1 660 DO ji = 2, jpim1 ! B grid : NO vector opt 661 ! ... scalar wind at I-point (fld being at T-point) 662 zwndi_f = 0.25 * ( sf(jp_wndi)%fnow(ji-1,jj ,1) + sf(jp_wndi)%fnow(ji ,jj ,1) & 663 & + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji ,jj-1,1) ) - rn_vfac * u_ice(ji,jj) 664 zwndj_f = 0.25 * ( sf(jp_wndj)%fnow(ji-1,jj ,1) + sf(jp_wndj)%fnow(ji ,jj ,1) & 665 & + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji ,jj-1,1) ) - rn_vfac * v_ice(ji,jj) 666 ! ... ice stress at I-point 667 zwnorm_f = zrhoa(ji,jj) * Cd_atm(ji,jj) * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f ) 668 utau_ice(ji,jj) = zwnorm_f * zwndi_f 669 vtau_ice(ji,jj) = zwnorm_f * zwndj_f 670 END DO 671 END DO 672 CALL lbc_lnk( utau_ice, 'I', -1. ) 673 CALL lbc_lnk( vtau_ice, 'I', -1. ) 674 ! 675 CASE( 'C' ) ! C-grid ice dynamics : U & V-points (same as ocean) 658 676 DO jj = 2, jpjm1 659 677 DO ji = fs_2, fs_jpim1 ! vect. opt. 660 utau_ice(ji,jj) = 0.5 * zrhoa(ji,jj) * Cd (ji,jj) * ( wndm_ice(ji+1,jj ) + wndm_ice(ji,jj) )&678 utau_ice(ji,jj) = 0.5 * zrhoa(ji,jj) * Cd_atm(ji,jj) * ( wndm_ice(ji+1,jj ) + wndm_ice(ji,jj) ) & 661 679 & * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - rn_vfac * u_ice(ji,jj) ) 662 vtau_ice(ji,jj) = 0.5 * zrhoa(ji,jj) * Cd (ji,jj) * ( wndm_ice(ji,jj+1 ) + wndm_ice(ji,jj) )&680 vtau_ice(ji,jj) = 0.5 * zrhoa(ji,jj) * Cd_atm(ji,jj) * ( wndm_ice(ji,jj+1 ) + wndm_ice(ji,jj) ) & 663 681 & * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - rn_vfac * v_ice(ji,jj) ) 664 682 END DO … … 666 684 CALL lbc_lnk( utau_ice, 'U', -1. ) 667 685 CALL lbc_lnk( vtau_ice, 'V', -1. ) 668 CALL lbc_lnk( wndm_ice, 'T', 1. )669 686 ! 670 687 END SELECT … … 705 722 REAL(wp), DIMENSION(:,:) , POINTER :: zevap, zsnw ! evaporation and snw distribution after wind blowing (LIM3) 706 723 REAL(wp), DIMENSION(:,:) , POINTER :: zrhoa 707 REAL(wp), DIMENSION(:,:) , POINTER :: Cd ! transfer coefficient for momentum (tau)708 724 !!--------------------------------------------------------------------- 709 725 ! … … 711 727 ! 712 728 CALL wrk_alloc( jpi,jpj,jpl, z_qlw, z_qsb, z_dqlw, z_dqsb ) 713 CALL wrk_alloc( jpi,jpj, zrhoa) 714 CALL wrk_alloc( jpi,jpj, Cd ) 715 716 Cd(:,:) = Cd_ice 717 718 ! Make ice-atm. drag dependent on ice concentration (see Lupkes et al. 2012) (clem) 719 #if defined key_lim3 720 IF( ln_Cd_L12 ) THEN 721 CALL Cdn10_Lupkes2012( Cd ) ! calculate new drag from Lupkes(2012) equations 722 ENDIF 723 #endif 724 725 ! 726 ! local scalars ( place there for vector optimisation purposes) 729 CALL wrk_alloc( jpi,jpj, zrhoa ) 730 ! 731 ! local scalars 727 732 zcoef_dqlw = 4.0 * 0.95 * Stef 728 733 zcoef_dqla = -Ls * 11637800. * (-5897.8) … … 752 757 ! ----------------------------! 753 758 754 ! ... turbulent heat fluxes 759 ! ... turbulent heat fluxes with Ch_atm recalculated in blk_ice_tau 755 760 ! Sensible Heat 756 z_qsb(ji,jj,jl) = zrhoa(ji,jj) * cpa * C d(ji,jj) * wndm_ice(ji,jj) * ( ptsu(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1))761 z_qsb(ji,jj,jl) = zrhoa(ji,jj) * cpa * Ch_atm(ji,jj) * wndm_ice(ji,jj) * (ptsu(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1)) 757 762 ! Latent Heat 758 qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, zrhoa(ji,jj) * Ls * C d(ji,jj) * wndm_ice(ji,jj)&759 & * ( 11637800. * EXP( -5897.8 / ptsu(ji,jj,jl) ) / zrhoa(ji,jj) - sf(jp_humi)%fnow(ji,jj,1)) )763 qla_ice(ji,jj,jl) = rn_efac * MAX( 0.e0, zrhoa(ji,jj) * Ls * Ch_atm(ji,jj) * wndm_ice(ji,jj) * & 764 & ( 11637800. * EXP( -5897.8 / ptsu(ji,jj,jl) ) / zrhoa(ji,jj) - sf(jp_humi)%fnow(ji,jj,1) ) ) 760 765 ! Latent heat sensitivity for ice (Dqla/Dt) 761 766 IF( qla_ice(ji,jj,jl) > 0._wp ) THEN 762 dqla_ice(ji,jj,jl) = rn_efac * zcoef_dqla * C d(ji,jj) * wndm_ice(ji,jj) / ( zst2 ) * EXP( -5897.8 / ptsu(ji,jj,jl))767 dqla_ice(ji,jj,jl) = rn_efac * zcoef_dqla * Ch_atm(ji,jj) * wndm_ice(ji,jj) / zst2 * EXP(-5897.8 / ptsu(ji,jj,jl)) 763 768 ELSE 764 769 dqla_ice(ji,jj,jl) = 0._wp … … 766 771 767 772 ! Sensible heat sensitivity (Dqsb_ice/Dtn_ice) 768 z_dqsb(ji,jj,jl) = zrhoa(ji,jj) * cpa * C d(ji,jj) * wndm_ice(ji,jj)773 z_dqsb(ji,jj,jl) = zrhoa(ji,jj) * cpa * Ch_atm(ji,jj) * wndm_ice(ji,jj) 769 774 770 775 ! ----------------------------! … … 786 791 CALL iom_put( 'precip' , tprecip * 86400. ) ! Total precipitation 787 792 788 #if defined key_lim3789 793 CALL wrk_alloc( jpi,jpj, zevap, zsnw ) 790 794 … … 797 801 ! --- evaporation minus precipitation --- ! 798 802 zsnw(:,:) = 0._wp 799 CALL lim_thd_snwblow( pfrld, zsnw ) ! snow distribution over ice after wind blowing800 emp_oce(:,:) = pfrld(:,:) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * (1._wp - zsnw )803 CALL ice_thd_snwblow( (1.-at_i_b(:,:)), zsnw ) ! snow distribution over ice after wind blowing 804 emp_oce(:,:) = ( 1._wp - at_i_b(:,:) ) * zevap(:,:) - ( tprecip(:,:) - sprecip(:,:) ) - sprecip(:,:) * (1._wp - zsnw ) 801 805 emp_ice(:,:) = SUM( a_i_b(:,:,:) * evap_ice(:,:,:), dim=3 ) - sprecip(:,:) * zsnw 802 806 emp_tot(:,:) = emp_oce(:,:) + emp_ice(:,:) 803 807 804 808 ! --- heat flux associated with emp --- ! 805 qemp_oce(:,:) = - pfrld(:,:) * zevap(:,:) * sst_m(:,:) * rcp& ! evap at sst809 qemp_oce(:,:) = - ( 1._wp - at_i_b(:,:) ) * zevap(:,:) * sst_m(:,:) * rcp & ! evap at sst 806 810 & + ( tprecip(:,:) - sprecip(:,:) ) * ( sf(jp_tair)%fnow(:,:,1) - rt0 ) * rcp & ! liquid precip at Tair 807 811 & + sprecip(:,:) * ( 1._wp - zsnw ) * & ! solid precip at min(Tair,Tsnow) … … 811 815 812 816 ! --- total solar and non solar fluxes --- ! 813 qns_tot(:,:) = pfrld(:,:) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) + qemp_ice(:,:) + qemp_oce(:,:) 814 qsr_tot(:,:) = pfrld(:,:) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 ) 817 qns_tot(:,:) = ( 1._wp - at_i_b(:,:) ) * qns_oce(:,:) + SUM( a_i_b(:,:,:) * qns_ice(:,:,:), dim=3 ) & 818 & + qemp_ice(:,:) + qemp_oce(:,:) 819 qsr_tot(:,:) = ( 1._wp - at_i_b(:,:) ) * qsr_oce(:,:) + SUM( a_i_b(:,:,:) * qsr_ice(:,:,:), dim=3 ) 815 820 816 821 ! --- heat content of precip over ice in J/m3 (to be used in 1D-thermo) --- ! … … 824 829 825 830 CALL wrk_dealloc( jpi,jpj, zevap, zsnw ) 826 #endif827 831 828 832 !-------------------------------------------------------------------- … … 846 850 CALL wrk_dealloc( jpi,jpj,jpl, z_qlw, z_qsb, z_dqlw, z_dqsb ) 847 851 CALL wrk_dealloc( jpi,jpj, zrhoa ) 848 CALL wrk_dealloc( jpi,jpj, Cd )849 852 ! 850 853 IF( nn_timing == 1 ) CALL timing_stop('blk_ice_flx') … … 973 976 974 977 #if defined key_lim3 978 975 979 SUBROUTINE Cdn10_Lupkes2012( Cd ) 976 980 !!---------------------------------------------------------------------- … … 1022 1026 1023 1027 END SUBROUTINE Cdn10_Lupkes2012 1028 1029 1030 SUBROUTINE Cdn10_Lupkes2015( Cd, Ch ) 1031 !!---------------------------------------------------------------------- 1032 !! *** ROUTINE Cdn10_Lupkes2015 *** 1033 !! 1034 !! ** pUrpose : 1lternative turbulent transfert coefficients formulation 1035 !! between sea-ice and atmosphere with distinct momentum 1036 !! and heat coefficients depending on sea-ice concentration 1037 !! and atmospheric stability (no meltponds effect for now). 1038 !! 1039 !! ** Method : The parameterization is adapted from Lupkes et al. (2015) 1040 !! and ECHAM6 atmospheric model. Compared to Lupkes2012 scheme, 1041 !! it considers specific skin and form drags (Andreas et al. 2010) 1042 !! to compute neutral transfert coefficients for both heat and 1043 !! momemtum fluxes. Atmospheric stability effect on transfert 1044 !! coefficient is also taken into account following Louis (1979). 1045 !! 1046 !! ** References : Lupkes et al. JGR 2015 (theory) 1047 !! Lupkes et al. ECHAM6 documentation 2015 (implementation) 1048 !! 1049 !!---------------------------------------------------------------------- 1050 ! 1051 REAL(wp), DIMENSION(:,:), INTENT(inout) :: Cd 1052 REAL(wp), DIMENSION(:,:), INTENT(inout) :: Ch 1053 REAL(wp), DIMENSION(jpi,jpj) :: zst, zqo_sat, zqi_sat 1054 ! 1055 ! ECHAM6 constants 1056 REAL(wp), PARAMETER :: z0_skin_ice = 0.69e-3_wp ! Eq. 43 [m] 1057 REAL(wp), PARAMETER :: z0_form_ice = 0.57e-3_wp ! Eq. 42 [m] 1058 REAL(wp), PARAMETER :: z0_ice = 1.00e-3_wp ! Eq. 15 [m] 1059 REAL(wp), PARAMETER :: zce10 = 2.80e-3_wp ! Eq. 41 1060 REAL(wp), PARAMETER :: zbeta = 1.1_wp ! Eq. 41 1061 REAL(wp), PARAMETER :: zc = 5._wp ! Eq. 13 1062 REAL(wp), PARAMETER :: zc2 = zc * zc 1063 REAL(wp), PARAMETER :: zam = 2. * zc ! Eq. 14 1064 REAL(wp), PARAMETER :: zah = 3. * zc ! Eq. 30 1065 REAL(wp), PARAMETER :: z1_alpha = 1._wp / 0.2_wp ! Eq. 51 1066 REAL(wp), PARAMETER :: z1_alphaf = z1_alpha ! Eq. 56 1067 REAL(wp), PARAMETER :: zbetah = 1.e-3_wp ! Eq. 26 1068 REAL(wp), PARAMETER :: zgamma = 1.25_wp ! Eq. 26 1069 REAL(wp), PARAMETER :: z1_gamma = 1._wp / zgamma 1070 REAL(wp), PARAMETER :: r1_3 = 1._wp / 3._wp 1071 ! 1072 INTEGER :: ji, jj ! dummy loop indices 1073 REAL(wp) :: zthetav_os, zthetav_is, zthetav_zu 1074 REAL(wp) :: zrib_o, zrib_i 1075 REAL(wp) :: zCdn_skin_ice, zCdn_form_ice, zCdn_ice 1076 REAL(wp) :: zChn_skin_ice, zChn_form_ice 1077 REAL(wp) :: z0w, z0i, zfmi, zfmw, zfhi, zfhw 1078 REAL(wp) :: zCdn_form_tmp 1079 !!---------------------------------------------------------------------- 1080 1081 ! Momentum Neutral Transfert Coefficients (should be a constant) 1082 zCdn_form_tmp = zce10 * ( LOG( 10._wp / z0_form_ice + 1._wp ) / LOG( rn_zu / z0_form_ice + 1._wp ) )**2 ! Eq. 40 1083 zCdn_skin_ice = ( vkarmn / LOG( rn_zu / z0_skin_ice + 1._wp ) )**2 ! Eq. 7 1084 zCdn_ice = zCdn_skin_ice ! Eq. 7 (cf Lupkes email for details) 1085 !zCdn_ice = 1.89e-3 ! old ECHAM5 value (cf Eq. 32) 1086 1087 ! Heat Neutral Transfert Coefficients 1088 zChn_skin_ice = vkarmn**2 / ( LOG( rn_zu / z0_ice + 1._wp ) * LOG( rn_zu * z1_alpha / z0_skin_ice + 1._wp ) ) ! Eq. 50 + Eq. 52 (cf Lupkes email for details) 1089 1090 ! Atmospheric and Surface Variables 1091 zst(:,:) = sst_m(:,:) + rt0 ! convert SST from Celcius to Kelvin 1092 zqo_sat(:,:) = 0.98_wp * q_sat( zst(:,:) , sf(jp_slp)%fnow(:,:,1) ) ! saturation humidity over ocean [kg/kg] 1093 zqi_sat(:,:) = 0.98_wp * q_sat( tm_su(:,:), sf(jp_slp)%fnow(:,:,1) ) ! saturation humidity over ice [kg/kg] 1094 ! 1095 !! DO jj = 2, jpjm1 1096 !! DO ji = fs_2, fs_jpim1 1097 DO jj = 1, jpj 1098 DO ji = 1, jpi 1099 ! Virtual potential temperature [K] 1100 zthetav_os = zst(ji,jj) * ( 1._wp + rctv0 * zqo_sat(ji,jj) ) ! over ocean 1101 zthetav_is = tm_su(ji,jj) * ( 1._wp + rctv0 * zqi_sat(ji,jj) ) ! ocean ice 1102 zthetav_zu = t_zu (ji,jj) * ( 1._wp + rctv0 * q_zu(ji,jj) ) ! at zu 1103 1104 ! Bulk Richardson Number (could use Ri_bulk function from aerobulk instead) 1105 zrib_o = grav / zthetav_os * ( zthetav_zu - zthetav_os ) * rn_zu / MAX( 0.5, wndm(ji,jj) )**2 ! over ocean 1106 zrib_i = grav / zthetav_is * ( zthetav_zu - zthetav_is ) * rn_zu / MAX( 0.5, wndm_ice(ji,jj) )**2 ! over ice 1107 1108 ! Momentum and Heat Neutral Transfert Coefficients 1109 zCdn_form_ice = zCdn_form_tmp * at_i_b(ji,jj) * ( 1._wp - at_i_b(ji,jj) )**zbeta ! Eq. 40 1110 zChn_form_ice = zCdn_form_ice / ( 1._wp + ( LOG( z1_alphaf ) / vkarmn ) * SQRT( zCdn_form_ice ) ) ! Eq. 53 1111 1112 ! Momentum and Heat Stability functions (possibility to use psi_m_ecmwf instead) 1113 z0w = rn_zu * EXP( -1._wp * vkarmn / SQRT( Cdn_oce(ji,jj) ) ) ! over water 1114 z0i = z0_skin_ice ! over ice (cf Lupkes email for details) 1115 IF( zrib_o <= 0._wp ) THEN 1116 zfmw = 1._wp - zam * zrib_o / ( 1._wp + 3._wp * zc2 * Cdn_oce(ji,jj) * SQRT( -zrib_o * ( rn_zu / z0w + 1._wp ) ) ) ! Eq. 10 1117 zfhw = ( 1._wp + ( zbetah * ( zthetav_os - zthetav_zu )**r1_3 / ( Chn_oce(ji,jj) * MAX(0.01, wndm(ji,jj)) ) & ! Eq. 26 1118 & )**zgamma )**z1_gamma 1119 ELSE 1120 zfmw = 1._wp / ( 1._wp + zam * zrib_o / SQRT( 1._wp + zrib_o ) ) ! Eq. 12 1121 zfhw = 1._wp / ( 1._wp + zah * zrib_o / SQRT( 1._wp + zrib_o ) ) ! Eq. 28 1122 ENDIF 1123 1124 IF( zrib_i <= 0._wp ) THEN 1125 zfmi = 1._wp - zam * zrib_i / (1._wp + 3._wp * zc2 * zCdn_ice * SQRT( -zrib_i * ( rn_zu / z0i + 1._wp))) ! Eq. 9 1126 zfhi = 1._wp - zah * zrib_i / (1._wp + 3._wp * zc2 * zCdn_ice * SQRT( -zrib_i * ( rn_zu / z0i + 1._wp))) ! Eq. 25 1127 ELSE 1128 zfmi = 1._wp / ( 1._wp + zam * zrib_i / SQRT( 1._wp + zrib_i ) ) ! Eq. 11 1129 zfhi = 1._wp / ( 1._wp + zah * zrib_i / SQRT( 1._wp + zrib_i ) ) ! Eq. 27 1130 ENDIF 1131 1132 ! Momentum Transfert Coefficients (Eq. 38) 1133 Cd(ji,jj) = zCdn_skin_ice * zfmi + & 1134 & zCdn_form_ice * ( zfmi * at_i_b(ji,jj) + zfmw * ( 1._wp - at_i_b(ji,jj) ) ) / MAX( 1.e-06, at_i_b(ji,jj) ) 1135 1136 ! Heat Transfert Coefficients (Eq. 49) 1137 Ch(ji,jj) = zChn_skin_ice * zfhi + & 1138 & zChn_form_ice * ( zfhi * at_i_b(ji,jj) + zfhw * ( 1._wp - at_i_b(ji,jj) ) ) / MAX( 1.e-06, at_i_b(ji,jj) ) 1139 ! 1140 END DO 1141 END DO 1142 !! CALL lbc_lnk_multi( Cd, 'T', 1., Ch, 'T', 1. ) 1143 ! 1144 END SUBROUTINE Cdn10_Lupkes2015 1145 1024 1146 #endif 1025 1026 1147 1027 1148 !!====================================================================== -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_coare.F90
r7646 r8738 52 52 !! COARE own values for given constants: 53 53 REAL(wp), PARAMETER :: & 54 & zi0 = 600., 54 & zi0 = 600., & !: scale height of the atmospheric boundary layer...1 55 55 & Beta0 = 1.25, & !: gustiness parameter 56 56 & rctv0 = 0.608 !: constant to obtain virtual temperature... … … 60 60 61 61 SUBROUTINE turb_coare( zt, zu, sst, t_zt, ssq, q_zt, U_zu, & 62 & Cd, Ch, Ce, t_zu, q_zu, U_blk ) 62 & Cd, Ch, Ce, t_zu, q_zu, U_blk, & 63 & Cdn, Chn, Cen ) 64 63 65 !!---------------------------------------------------------------------- 64 66 !! *** ROUTINE turb_coare *** … … 106 108 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: q_zu ! spec. humidity adjusted at zu [kg/kg] 107 109 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: U_blk ! bulk wind at 10m [m/s] 110 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Cdn, Chn, Cen ! neutral transfer coefficients 108 111 ! 109 112 INTEGER :: j_itt … … 246 249 Ce = ztmp0*q_star/dq_zu 247 250 ! 251 ztmp1 = zu + z0 252 Cdn = vkarmn*vkarmn / (log(ztmp1/z0 )*log(ztmp1/z0 )) 253 Chn = vkarmn*vkarmn / (log(ztmp1/z0t)*log(ztmp1/z0t)) 254 Cen = Chn 255 ! 248 256 CALL wrk_dealloc( jpi,jpj, u_star, t_star, q_star, zeta_u, dt_zu, dq_zu ) 249 257 CALL wrk_dealloc( jpi,jpj, znu_a, z0, z0t, ztmp0, ztmp1, ztmp2 ) -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_coare3p5.F90
r7646 r8738 58 58 CONTAINS 59 59 60 SUBROUTINE turb_coare3p5( zt, zu, sst, t_zt, ssq, q_zt, U_zu, & 61 & Cd, Ch, Ce, t_zu, q_zu, U_blk ) 60 SUBROUTINE turb_coare3p5( zt, zu, sst, t_zt, ssq, q_zt, U_zu, & 61 & Cd, Ch, Ce, t_zu, q_zu, U_blk, & 62 & Cdn, Chn, Cen ) 63 62 64 !!---------------------------------------------------------------------------------- 63 65 !! *** ROUTINE turb_coare3p5 *** … … 105 107 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: q_zu ! spec. humidity adjusted at zu [kg/kg] 106 108 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: U_blk ! bulk wind at 10m [m/s] 109 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Cdn, Chn, Cen ! neutral transfer coefficients 107 110 ! 108 111 INTEGER :: j_itt … … 252 255 Ce = ztmp0*q_star/dq_zu 253 256 ! 257 ztmp1 = zu + z0 258 Cdn = vkarmn*vkarmn / (log(ztmp1/z0 )*log(ztmp1/z0 )) 259 Chn = vkarmn*vkarmn / (log(ztmp1/z0t)*log(ztmp1/z0t)) 260 Cen = Chn 261 ! 254 262 CALL wrk_dealloc( jpi,jpj, u_star, t_star, q_star, zeta_u, dt_zu, dq_zu ) 255 263 CALL wrk_dealloc( jpi,jpj, znu_a, z0, z0t, ztmp0, ztmp1, ztmp2 ) -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_ecmwf.F90
r7646 r8738 64 64 65 65 SUBROUTINE TURB_ECMWF( zt, zu, sst, t_zt, ssq , q_zt , U_zu, & 66 & Cd, Ch, Ce , t_zu, q_zu, U_blk ) 66 & Cd, Ch, Ce , t_zu, q_zu, U_blk, & 67 & Cdn, Chn, Cen ) 67 68 !!---------------------------------------------------------------------------------- 68 69 !! *** ROUTINE turb_ecmwf *** … … 112 113 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: q_zu ! spec. humidity adjusted at zu [kg/kg] 113 114 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: U_blk ! bulk wind at 10m [m/s] 115 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Cdn, Chn, Cen ! neutral transfer coefficients 114 116 ! 115 117 INTEGER :: j_itt … … 266 268 dt_zu = t_zu - sst ; dt_zu = SIGN( MAX(ABS(dt_zu),1.E-6), dt_zu ) 267 269 dq_zu = q_zu - ssq ; dq_zu = SIGN( MAX(ABS(dq_zu),1.E-9), dq_zu ) 270 268 271 END IF 269 272 … … 271 274 ztmp1 = zu + z0 272 275 ztmp0 = ztmp1*Linv 273 func_m = log(ztmp1) - LOG(z0 ) - psi_m_ecmwf(ztmp0) + psi_m_ecmwf(z0*Linv)276 func_m = log(ztmp1) - LOG(z0 ) - psi_m_ecmwf(ztmp0) + psi_m_ecmwf(z0 *Linv) 274 277 func_h = log(ztmp1) - LOG(z0t) - psi_h_ecmwf(ztmp0) + psi_h_ecmwf(z0t*Linv) 275 278 … … 280 283 ztmp1 = log((zu + z0)/z0q) - psi_h_ecmwf((zu + z0)*Linv) + psi_h_ecmwf(z0q*Linv) ! func_q 281 284 Ce = vkarmn*vkarmn/(func_m*ztmp1) 285 286 ztmp1 = zu + z0 287 Cdn = vkarmn*vkarmn / (log(ztmp1/z0 )*log(ztmp1/z0 )) 288 Chn = vkarmn*vkarmn / (log(ztmp1/z0t)*log(ztmp1/z0t)) 289 Cen = vkarmn*vkarmn / (log(ztmp1/z0q)*log(ztmp1/z0q)) 282 290 283 291 CALL wrk_dealloc( jpi,jpj, u_star, t_star, q_star, func_m, func_h, dt_zu, dq_zu, Linv ) -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_algo_ncar.F90
r7753 r8738 48 48 ! ! NCAR own values for given constants: 49 49 REAL(wp), PARAMETER :: rctv0 = 0.608 ! constant to obtain virtual temperature... 50 51 50 !!---------------------------------------------------------------------- 52 51 CONTAINS 53 52 54 53 SUBROUTINE turb_ncar( zt, zu, sst, t_zt, ssq, q_zt, U_zu, & 55 & Cd, Ch, Ce, t_zu, q_zu, U_blk ) 54 & Cd, Ch, Ce, t_zu, q_zu, U_blk, & 55 & Cdn, Chn, Cen ) 56 56 57 !!---------------------------------------------------------------------------------- 57 58 !! *** ROUTINE turb_ncar *** … … 112 113 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: q_zu ! spec. humidity adjusted at zu [kg/kg] 113 114 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: U_blk ! bulk wind at 10m [m/s] 115 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: Cdn, Chn, Cen ! neutral transfer coefficients 114 116 ! 115 117 INTEGER :: j_itt … … 199 201 ztmp0 = MAX( 0.25 , U_blk/(1. + sqrt_Cd_n10/vkarmn*(LOG(zu/10.) - ztmp2)) ) ! U_n10 (ztmp2 == psi_m(zeta_u)) 200 202 ztmp0 = cd_neutral_10m(ztmp0) ! Cd_n10 203 Cdn(:,:) = ztmp0 201 204 sqrt_Cd_n10 = sqrt(ztmp0) 202 205 203 206 stab = 0.5 + sign(0.5,zeta_u) ! update stability 204 207 Cx_n10 = 1.e-3*sqrt_Cd_n10*(18.*stab + 32.7*(1. - stab)) ! L&Y 2004 eq. (6c-6d) (Cx_n10 == Ch_n10) 208 Chn(:,:) = Cx_n10 205 209 206 210 !! Update of transfer coefficients: … … 216 220 217 221 Cx_n10 = 1.e-3 * (34.6 * sqrt_Cd_n10) ! L&Y 2004 eq. (6b) ! Cx_n10 == Ce_n10 222 Cen(:,:) = Cx_n10 218 223 ztmp1 = 1. + Cx_n10*ztmp0 219 224 Ce = Cx_n10*ztmp2 / ztmp1 ! L&Y 2004 eq. (10c) -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r8733 r8738 29 29 USE ice ! ice variables 30 30 #endif 31 #if defined key_lim232 USE par_ice_2 ! ice parameters33 USE ice_2 ! ice variables34 #endif35 31 USE cpl_oasis3 ! OASIS3 coupling 36 32 USE geo2ocean ! 37 33 USE oce , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev 38 USE albedo 34 USE albedooce ! 39 35 USE eosbn2 ! 40 36 USE sbcrnf, ONLY : l_rnfcpl … … 44 40 #endif 45 41 #if defined key_lim3 46 USE limthd_dh ! for CALL lim_thd_snwblow42 USE icethd_dh ! for CALL ice_thd_snwblow 47 43 #endif 48 44 ! … … 58 54 59 55 PUBLIC sbc_cpl_init ! routine called by sbcmod.F90 60 PUBLIC sbc_cpl_rcv ! routine called by sbc_ice_lim(_2).F9056 PUBLIC sbc_cpl_rcv ! routine called by icestp.F90 61 57 PUBLIC sbc_cpl_snd ! routine called by step.F90 62 PUBLIC sbc_cpl_ice_tau ! routine called by sbc_ice_lim(_2).F9063 PUBLIC sbc_cpl_ice_flx ! routine called by sbc_ice_lim(_2).F9058 PUBLIC sbc_cpl_ice_tau ! routine called by icestp.F90 59 PUBLIC sbc_cpl_ice_flx ! routine called by icestp.F90 64 60 PUBLIC sbc_cpl_alloc ! routine called in sbcice_cice.F90 65 61 … … 207 203 ALLOCATE( albedo_oce_mix(jpi,jpj), nrcvinfo(jprcv), STAT=ierr(1) ) 208 204 209 #if ! defined key_lim3 && ! defined key_ lim2 && ! defined key_cice205 #if ! defined key_lim3 && ! defined key_cice 210 206 ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) ) ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init) 211 207 #endif … … 504 500 ! 505 501 ! non solar sensitivity mandatory for LIM ice model 506 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 4.AND. nn_components /= jp_iam_sas ) &502 IF( TRIM( sn_rcv_dqnsdt%cldes ) == 'none' .AND. k_ice /= 0 .AND. k_ice /= 3 .AND. nn_components /= jp_iam_sas ) & 507 503 CALL ctl_stop( 'sbc_cpl_init: sn_rcv_dqnsdt%cldes must be coupled in namsbc_cpl namelist' ) 508 504 ! non solar sensitivity mandatory for mixed oce-ice solar radiation coupling technique … … 1218 1214 IF( srcv(jpr_ocx1)%laction ) THEN ! received by sas in case of opa <-> sas coupling 1219 1215 ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1) 1220 ub (:,:,1) = ssu_m(:,:) ! will be used in sbcice_limin the call of lim_sbc_tau1216 ub (:,:,1) = ssu_m(:,:) ! will be used in icestp in the call of lim_sbc_tau 1221 1217 un (:,:,1) = ssu_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling 1222 1218 CALL iom_put( 'ssu_m', ssu_m ) … … 1224 1220 IF( srcv(jpr_ocy1)%laction ) THEN 1225 1221 ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1) 1226 vb (:,:,1) = ssv_m(:,:) ! will be used in sbcice_limin the call of lim_sbc_tau1222 vb (:,:,1) = ssv_m(:,:) ! will be used in icestp in the call of lim_sbc_tau 1227 1223 vn (:,:,1) = ssv_m(:,:) ! will be used in sbc_cpl_snd if atmosphere coupling 1228 1224 CALL iom_put( 'ssv_m', ssv_m ) … … 1528 1524 1529 1525 1530 SUBROUTINE sbc_cpl_ice_flx( p _frld, palbi, psst, pist )1526 SUBROUTINE sbc_cpl_ice_flx( picefr, palbi, psst, pist ) 1531 1527 !!---------------------------------------------------------------------- 1532 1528 !! *** ROUTINE sbc_cpl_ice_flx *** … … 1561 1557 !! 1562 1558 !! ** Details 1563 !! qns_tot = pfrld * qns_oce + ( 1 - pfrld ) * qns_ice=> provided1559 !! qns_tot = (1-a) * qns_oce + a * qns_ice => provided 1564 1560 !! + qemp_oce + qemp_ice => recalculated and added up to qns 1565 1561 !! 1566 !! qsr_tot = pfrld * qsr_oce + ( 1 - pfrld ) * qsr_ice=> provided1562 !! qsr_tot = (1-a) * qsr_oce + a * qsr_ice => provided 1567 1563 !! 1568 1564 !! emp_tot = emp_oce + emp_ice => calving is provided and added to emp_tot (and emp_oce). … … 1578 1574 !! sprecip solid precipitation over the ocean 1579 1575 !!---------------------------------------------------------------------- 1580 REAL(wp), INTENT(in ), DIMENSION(:,:) :: p_frld ! leadfraction [0 to 1]1576 REAL(wp), INTENT(in), DIMENSION(:,:) :: picefr ! ice fraction [0 to 1] 1581 1577 ! optional arguments, used only in 'mixed oce-ice' case 1582 REAL(wp), INTENT(in 1583 REAL(wp), INTENT(in 1584 REAL(wp), INTENT(in 1578 REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL :: palbi ! all skies ice albedo 1579 REAL(wp), INTENT(in), DIMENSION(:,: ), OPTIONAL :: psst ! sea surface temperature [Celsius] 1580 REAL(wp), INTENT(in), DIMENSION(:,:,:), OPTIONAL :: pist ! ice surface temperature [Kelvin] 1585 1581 ! 1586 1582 INTEGER :: jl ! dummy loop index 1587 REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, zcptrain, zcptsnw, zice fr, zmsk, zsnw1583 REAL(wp), POINTER, DIMENSION(:,: ) :: zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw 1588 1584 REAL(wp), POINTER, DIMENSION(:,: ) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice 1589 1585 REAL(wp), POINTER, DIMENSION(:,: ) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice … … 1593 1589 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_ice_flx') 1594 1590 ! 1595 CALL wrk_alloc( jpi,jpj, zcptn, zcptrain, zcptsnw, zice fr, zmsk, zsnw )1591 CALL wrk_alloc( jpi,jpj, zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw ) 1596 1592 CALL wrk_alloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice ) 1597 1593 CALL wrk_alloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) … … 1599 1595 1600 1596 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) 1601 zice fr(:,:) = 1.- p_frld(:,:)1597 ziceld(:,:) = 1. - picefr(:,:) 1602 1598 zcptn(:,:) = rcp * sst_m(:,:) 1603 1599 ! … … 1615 1611 ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here 1616 1612 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1617 zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * zicefr(:,:)1613 zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * picefr(:,:) 1618 1614 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1619 zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1)1620 zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * zicefr(:,:)1615 zemp_tot(:,:) = ziceld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + picefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 1616 zemp_ice(:,:) = frcv(jpr_semp)%z3(:,:,1) * picefr(:,:) 1621 1617 zsprecip(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_semp)%z3(:,:,1) 1622 1618 ztprecip(:,:) = frcv(jpr_semp)%z3(:,:,1) - frcv(jpr_sbpr)%z3(:,:,1) + zsprecip(:,:) … … 1624 1620 1625 1621 #if defined key_lim3 1626 ! zsnw = snow fraction over ice after wind blowing (= zicefr if no blowing)1627 zsnw(:,:) = 0._wp ; CALL lim_thd_snwblow( p_frld, zsnw )1622 ! zsnw = snow fraction over ice after wind blowing (=picefr if no blowing) 1623 zsnw(:,:) = 0._wp ; CALL ice_thd_snwblow( ziceld, zsnw ) 1628 1624 1629 1625 ! --- evaporation minus precipitation corrected (because of wind blowing on snow) --- ! 1630 zemp_ice(:,:) = zemp_ice(:,:) + zsprecip(:,:) * ( zicefr(:,:) - zsnw(:,:) ) ! emp_ice = A * sublimation - zsnw * sprecip1626 zemp_ice(:,:) = zemp_ice(:,:) + zsprecip(:,:) * ( picefr(:,:) - zsnw(:,:) ) ! emp_ice = A * sublimation - zsnw * sprecip 1631 1627 zemp_oce(:,:) = zemp_tot(:,:) - zemp_ice(:,:) ! emp_oce = emp_tot - emp_ice 1632 1628 1633 1629 ! --- evaporation over ocean (used later for qemp) --- ! 1634 zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:)1630 zevap_oce(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) 1635 1631 1636 1632 ! --- evaporation over ice (kg/m2/s) --- ! … … 1679 1675 1680 1676 #else 1681 zsnw(:,:) = zicefr(:,:)1677 zsnw(:,:) = picefr(:,:) 1682 1678 ! --- Continental fluxes --- ! 1683 1679 IF( srcv(jpr_rnf)%laction ) THEN ! runoffs (included in emp later on) … … 1718 1714 IF( iom_use('snow_ao_cea') ) CALL iom_put( 'snow_ao_cea' , sprecip(:,:) * ( 1._wp - zsnw(:,:) ) ) ! Snow over ice-free ocean (cell average) 1719 1715 IF( iom_use('snow_ai_cea') ) CALL iom_put( 'snow_ai_cea' , sprecip(:,:) * zsnw(:,:) ) ! Snow over sea-ice (cell average) 1720 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea' , frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * tmask(:,:,1) ) ! Sublimation over sea-ice (cell average)1716 IF( iom_use('subl_ai_cea') ) CALL iom_put( 'subl_ai_cea' , frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * tmask(:,:,1) ) ! Sublimation over sea-ice (cell average) 1721 1717 IF( iom_use('evap_ao_cea') ) CALL iom_put( 'evap_ao_cea' , ( frcv(jpr_tevp)%z3(:,:,1) & 1722 & - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average)1718 & - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average) 1723 1719 ! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf 1724 1720 ! … … 1738 1734 ENDIF 1739 1735 CASE( 'oce and ice' ) ! the total flux is computed from ocean and ice fluxes 1740 zqns_tot(:,:) = p_frld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1)1736 zqns_tot(:,:) = ziceld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 1741 1737 IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 1742 1738 DO jl=1,jpl … … 1745 1741 ENDDO 1746 1742 ELSE 1747 qns_tot(:,:) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)1743 qns_tot(:,:) = qns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1748 1744 DO jl=1,jpl 1749 zqns_tot(:,: ) = zqns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)1745 zqns_tot(:,: ) = zqns_tot(:,:) + picefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1750 1746 zqns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1751 1747 ENDDO … … 1755 1751 zqns_tot(:,: ) = frcv(jpr_qnsmix)%z3(:,:,1) 1756 1752 zqns_ice(:,:,1) = frcv(jpr_qnsmix)%z3(:,:,1) & 1757 & + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * p_frld(:,:) &1758 & + pist(:,:,1) * zicefr(:,:) ) )1753 & + frcv(jpr_dqnsdt)%z3(:,:,1) * ( pist(:,:,1) - ( (rt0 + psst(:,: ) ) * ziceld(:,:) & 1754 & + pist(:,:,1) * picefr(:,:) ) ) 1759 1755 END SELECT 1760 1756 ! … … 1767 1763 #if defined key_lim3 1768 1764 ! --- non solar flux over ocean --- ! 1769 ! note: p_frld cannot be = 0 since we limit the ice concentration to amax1765 ! note: ziceld cannot be = 0 since we limit the ice concentration to amax 1770 1766 zqns_oce = 0._wp 1771 WHERE( p_frld /= 0._wp ) zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:)1767 WHERE( ziceld /= 0._wp ) zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / ziceld(:,:) 1772 1768 1773 1769 ! Heat content per unit mass of snow (J/kg) … … 1776 1772 ENDWHERE 1777 1773 ! Heat content per unit mass of rain (J/kg) 1778 zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * p_frld(:,:) )1774 zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * ziceld(:,:) ) 1779 1775 1780 1776 ! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- ! … … 1791 1787 & + zsprecip(:,:) * ( 1._wp - zsnw ) * ( zcptsnw (:,:) - lfus ) ! solid precip over ocean + snow melting 1792 1788 zqemp_ice(:,:) = zsprecip(:,:) * zsnw * ( zcptsnw (:,:) - lfus ) ! solid precip over ice (qevap_ice=0 since atm. does not take it into account) 1793 !! zqemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) * zcptsnw (:,:) & ! ice evap1789 !! zqemp_ice(:,:) = - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) * zcptsnw (:,:) & ! ice evap 1794 1790 !! & + zsprecip(:,:) * zsnw * zqprec_ice(:,:) * r1_rhosn ! solid precip over ice 1795 1791 … … 1824 1820 ! clem: this formulation is certainly wrong... but better than it was... 1825 1821 zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with: 1826 & - ( p_frld(:,:) * zsprecip(:,:) * lfus ) & ! remove the latent heat flux of solid precip. melting1822 & - ( ziceld(:,:) * zsprecip(:,:) * lfus ) & ! remove the latent heat flux of solid precip. melting 1827 1823 & - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST) 1828 1824 & - zemp_ice(:,:) ) * zcptn(:,:) 1829 1825 1830 1826 IF( ln_mixcpl ) THEN 1831 qns_tot(:,:) = qns(:,:) * p_frld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk1827 qns_tot(:,:) = qns(:,:) * ziceld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 1832 1828 qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:) 1833 1829 DO jl=1,jpl … … 1845 1841 IF( iom_use('hflx_snow_cea') ) CALL iom_put('hflx_snow_cea', sprecip(:,:) * ( zcptsnw(:,:) - Lfus ) ) ! heat flux from snow (cell average) 1846 1842 IF( iom_use('hflx_rain_cea') ) CALL iom_put('hflx_rain_cea',( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) ) ! heat flux from rain (cell average) 1847 IF( iom_use('hflx_evap_cea') ) CALL iom_put('hflx_evap_cea',(frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) & ! heat flux from from evap (cell average)1843 IF( iom_use('hflx_evap_cea') ) CALL iom_put('hflx_evap_cea',(frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) & ! heat flux from from evap (cell average) 1848 1844 & ) * zcptn(:,:) * tmask(:,:,1) ) 1849 1845 IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea',sprecip(:,:) * (zcptsnw(:,:) - Lfus) * (1._wp - zsnw(:,:)) ) ! heat flux from snow (over ocean) … … 1869 1865 zqsr_ice(:,:,1) = frcv(jpr_qsrice)%z3(:,:,1) 1870 1866 CASE( 'oce and ice' ) 1871 zqsr_tot(:,: ) = p_frld(:,:) * frcv(jpr_qsroce)%z3(:,:,1)1867 zqsr_tot(:,: ) = ziceld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 1872 1868 IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 1873 1869 DO jl=1,jpl … … 1876 1872 ENDDO 1877 1873 ELSE 1878 qsr_tot(:,: ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)1874 qsr_tot(:,: ) = qsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 1879 1875 DO jl=1,jpl 1880 zqsr_tot(:,: ) = zqsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)1876 zqsr_tot(:,: ) = zqsr_tot(:,:) + picefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 1881 1877 zqsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1882 1878 ENDDO … … 1888 1884 ! ( see OASIS3 user guide, 5th edition, p39 ) 1889 1885 zqsr_ice(:,:,1) = frcv(jpr_qsrmix)%z3(:,:,1) * ( 1.- palbi(:,:,1) ) & 1890 & / ( 1.- ( albedo_oce_mix(:,: ) * p_frld(:,:) &1891 & + palbi (:,:,1) * zicefr(:,:) ) )1886 & / ( 1.- ( albedo_oce_mix(:,: ) * ziceld(:,:) & 1887 & + palbi (:,:,1) * picefr(:,:) ) ) 1892 1888 END SELECT 1893 1889 IF( ln_dm2dc .AND. ln_cpl ) THEN ! modify qsr to include the diurnal cycle … … 1900 1896 #if defined key_lim3 1901 1897 ! --- solar flux over ocean --- ! 1902 ! note: p_frld cannot be = 0 since we limit the ice concentration to amax1898 ! note: ziceld cannot be = 0 since we limit the ice concentration to amax 1903 1899 zqsr_oce = 0._wp 1904 WHERE( p_frld /= 0._wp ) zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / p_frld(:,:)1900 WHERE( ziceld /= 0._wp ) zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / ziceld(:,:) 1905 1901 1906 1902 IF( ln_mixcpl ) THEN ; qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) + zqsr_oce(:,:)* zmsk(:,:) … … 1909 1905 1910 1906 IF( ln_mixcpl ) THEN 1911 qsr_tot(:,:) = qsr(:,:) * p_frld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk1907 qsr_tot(:,:) = qsr(:,:) * ziceld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 1912 1908 qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) + zqsr_tot(:,:)* zmsk(:,:) 1913 1909 DO jl=1,jpl … … 1950 1946 1951 1947 ! Surface transimission parameter io (Maykut Untersteiner , 1971 ; Ebert and Curry, 1993 ) 1952 ! Used for LIM 2 and LIM31948 ! Used for LIM3 1953 1949 ! Coupled case: since cloud cover is not received from atmosphere 1954 1950 ! ===> used prescribed cloud fraction representative for polar oceans in summer (0.81) … … 1956 1952 fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 1957 1953 1958 CALL wrk_dealloc( jpi,jpj, zcptn, zcptrain, zcptsnw, zice fr, zmsk, zsnw )1954 CALL wrk_dealloc( jpi,jpj, zcptn, zcptrain, zcptsnw, ziceld, zmsk, zsnw ) 1959 1955 CALL wrk_dealloc( jpi,jpj, zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice ) 1960 1956 CALL wrk_dealloc( jpi,jpj, zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) … … 2002 1998 ! we must send the surface potential temperature 2003 1999 IF( l_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( tsn(:,:,1,jp_tem), tsn(:,:,1,jp_sal) ) 2004 ELSE 2000 ELSE ; ztmp1(:,:) = tsn(:,:,1,jp_tem) 2005 2001 ENDIF 2006 2002 ! … … 2115 2111 SELECT CASE( sn_snd_thick%clcat ) 2116 2112 CASE( 'yes' ) 2117 ztmp3(:,:,1:jpl) = h t_i(:,:,1:jpl) * a_i(:,:,1:jpl)2118 ztmp4(:,:,1:jpl) = h t_s(:,:,1:jpl) * a_i(:,:,1:jpl)2113 ztmp3(:,:,1:jpl) = h_i(:,:,1:jpl) * a_i(:,:,1:jpl) 2114 ztmp4(:,:,1:jpl) = h_s(:,:,1:jpl) * a_i(:,:,1:jpl) 2119 2115 CASE( 'no' ) 2120 2116 ztmp3(:,:,:) = 0.0 ; ztmp4(:,:,:) = 0.0 2121 2117 DO jl=1,jpl 2122 ztmp3(:,:,1) = ztmp3(:,:,1) + h t_i(:,:,jl) * a_i(:,:,jl)2123 ztmp4(:,:,1) = ztmp4(:,:,1) + h t_s(:,:,jl) * a_i(:,:,jl)2118 ztmp3(:,:,1) = ztmp3(:,:,1) + h_i(:,:,jl) * a_i(:,:,jl) 2119 ztmp4(:,:,1) = ztmp4(:,:,1) + h_s(:,:,jl) * a_i(:,:,jl) 2124 2120 ENDDO 2125 2121 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) … … 2128 2124 SELECT CASE( sn_snd_thick%clcat ) 2129 2125 CASE( 'yes' ) 2130 ztmp3(:,:,1:jpl) = h t_i(:,:,1:jpl)2131 ztmp4(:,:,1:jpl) = h t_s(:,:,1:jpl)2126 ztmp3(:,:,1:jpl) = h_i(:,:,1:jpl) 2127 ztmp4(:,:,1:jpl) = h_s(:,:,1:jpl) 2132 2128 CASE( 'no' ) 2133 2129 WHERE( SUM( a_i, dim=3 ) /= 0. ) 2134 ztmp3(:,:,1) = SUM( h t_i * a_i, dim=3 ) / SUM( a_i, dim=3 )2135 ztmp4(:,:,1) = SUM( h t_s * a_i, dim=3 ) / SUM( a_i, dim=3 )2130 ztmp3(:,:,1) = SUM( h_i * a_i, dim=3 ) / SUM( a_i, dim=3 ) 2131 ztmp4(:,:,1) = SUM( h_s * a_i, dim=3 ) / SUM( a_i, dim=3 ) 2136 2132 ELSEWHERE 2137 2133 ztmp3(:,:,1) = 0. -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcfwb.F90
r8733 r8738 17 17 USE dom_oce ! ocean space and time domain 18 18 USE sbc_oce ! surface ocean boundary condition 19 USE sbc_ice , ONLY : snwice_mass, snwice_mass_b, snwice_fmass 19 20 USE phycst ! physical constants 20 21 USE sbcrnf ! ocean runoffs … … 94 95 ! and in case of no melt, it can generate HSSW. 95 96 ! 96 #if ! defined key_lim 2 && ! defined key_lim3 && ! defined key_cice97 #if ! defined key_lim3 && ! defined key_cice 97 98 snwice_mass_b(:,:) = 0.e0 ! no sea-ice model is being used : no snow+ice mass 98 99 snwice_mass (:,:) = 0.e0 -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
r8733 r8738 137 137 CALL cice_sbc_force(kt) 138 138 ELSE IF ( ksbc == jp_purecpl ) THEN 139 CALL sbc_cpl_ice_flx( 1.0-fr_i)139 CALL sbc_cpl_ice_flx( fr_i ) 140 140 ENDIF 141 141 … … 230 230 CALL lbc_lnk ( fr_iv , 'V', 1. ) 231 231 232 ! ! embedded sea ice 233 IF( nn_ice_embd /= 0 ) THEN ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass 234 CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. ) 235 CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. ) 236 snwice_mass (:,:) = ( rhosn * ztmp1(:,:) + rhoic * ztmp2(:,:) ) 237 snwice_mass_b(:,:) = snwice_mass(:,:) 238 ELSE 239 snwice_mass (:,:) = 0.0_wp ! no mass exchanges 240 snwice_mass_b(:,:) = 0.0_wp ! no mass exchanges 241 ENDIF 232 ! set the snow+ice mass 233 CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. ) 234 CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. ) 235 snwice_mass (:,:) = ( rhosn * ztmp1(:,:) + rhoic * ztmp2(:,:) ) 236 snwice_mass_b(:,:) = snwice_mass(:,:) 237 242 238 IF( .NOT.ln_rstart ) THEN 243 IF( nn_ice_embd == 2 ) THEN ! full embedment (case 2)deplete the initial ssh below sea-ice area239 IF( ln_ice_embd ) THEN ! embedded sea-ice: deplete the initial ssh below sea-ice area 244 240 sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 245 241 sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 … … 473 469 CALL nemo2cice(ztmp,vocn,'F', -1. ) 474 470 475 IF( nn_ice_embd == 2) THEN !== embedded sea ice: compute representative ice top surface ==!471 IF( ln_ice_embd ) THEN !== embedded sea ice: compute representative ice top surface ==! 476 472 ! 477 473 ! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1} … … 676 672 CALL lbc_lnk ( fr_iv , 'V', 1. ) 677 673 678 ! ! embedded sea ice 679 IF( nn_ice_embd /= 0 ) THEN ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass 680 CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. ) 681 CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. ) 682 snwice_mass (:,:) = ( rhosn * ztmp1(:,:) + rhoic * ztmp2(:,:) ) 683 snwice_mass_b(:,:) = snwice_mass(:,:) 684 snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) / dt 685 ENDIF 674 ! set the snow+ice mass 675 CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. ) 676 CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. ) 677 snwice_mass (:,:) = ( rhosn * ztmp1(:,:) + rhoic * ztmp2(:,:) ) 678 snwice_mass_b(:,:) = snwice_mass(:,:) 679 snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) / dt 686 680 687 681 ! Release work space … … 727 721 728 722 DO jl = 1,ncat 729 CALL cice2nemo(vsnon(:,:,jl,:),h t_s(:,:,jl),'T', 1. )730 CALL cice2nemo(vicen(:,:,jl,:),h t_i(:,:,jl),'T', 1. )723 CALL cice2nemo(vsnon(:,:,jl,:),h_s(:,:,jl),'T', 1. ) 724 CALL cice2nemo(vicen(:,:,jl,:),h_i(:,:,jl),'T', 1. ) 731 725 ENDDO 732 726 ! -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r8733 r8738 33 33 USE sbcblk ! surface boundary condition: bulk formulation 34 34 USE sbcice_if ! surface boundary condition: ice-if sea-ice model 35 USE sbcice_lim ! surface boundary condition: LIM 3.0 sea-ice model 36 USE sbcice_lim_2 ! surface boundary condition: LIM 2.0 sea-ice model 35 #if defined key_lim3 36 USE icestp ! surface boundary condition: LIM 3.0 sea-ice model 37 #endif 37 38 USE sbcice_cice ! surface boundary condition: CICE sea-ice model 38 39 USE sbcisf ! surface boundary condition: ice-shelf … … 90 91 NAMELIST/namsbc/ nn_fsbc , & 91 92 & ln_usr , ln_flx , ln_blk , & 92 & ln_cpl , ln_mixcpl, nn_components, nn_limflx,&93 & nn_ice , nn_ice_embd, &93 & ln_cpl , ln_mixcpl, nn_components, & 94 & nn_ice , ln_ice_embd, & 94 95 & ln_traqsr, ln_dm2dc , & 95 96 & ln_rnf , nn_fwb , ln_ssr , ln_isf , ln_apr_dyn , & … … 117 118 #if defined key_agrif 118 119 IF( Agrif_Root() ) THEN ! AGRIF zoom (cf r1242: possibility to run without ice in fine grid) 119 IF( lk_lim2 ) nn_ice = 2 120 IF( lk_lim3 ) nn_ice = 3 121 IF( lk_cice ) nn_ice = 4 120 IF( lk_lim3 ) nn_ice = 2 121 IF( lk_cice ) nn_ice = 3 122 122 ENDIF 123 123 #else 124 IF( lk_lim2 ) nn_ice = 2 125 IF( lk_lim3 ) nn_ice = 3 126 IF( lk_cice ) nn_ice = 4 124 IF( lk_lim3 ) nn_ice = 2 125 IF( lk_cice ) nn_ice = 3 127 126 #endif 128 127 ! … … 140 139 WRITE(numout,*) ' OASIS coupling (with atm or sas) lk_oasis = ', lk_oasis 141 140 WRITE(numout,*) ' components of your executable nn_components = ', nn_components 142 WRITE(numout,*) ' Multicategory heat flux formulation (LIM3) nn_limflx = ', nn_limflx143 141 WRITE(numout,*) ' Sea-ice : ' 144 142 WRITE(numout,*) ' ice management in the sbc (=0/1/2/3) nn_ice = ', nn_ice 145 WRITE(numout,*) ' ice -ocean embedded/levitating (=0/1/2) nn_ice_embd = ', nn_ice_embd143 WRITE(numout,*) ' ice embedded into ocean ln_ice_embd = ', ln_ice_embd 146 144 WRITE(numout,*) ' Misc. options of sbc : ' 147 145 WRITE(numout,*) ' Light penetration in temperature Eq. ln_traqsr = ', ln_traqsr … … 201 199 CASE( 0 ) !- no ice in the domain 202 200 CASE( 1 ) !- Ice-cover climatology ("Ice-if" model) 203 CASE( 2 ) !- LIM2 ice model 204 IF( .NOT.( ln_blk .OR. ln_cpl ) ) CALL ctl_stop( 'sbc_init : LIM2 sea-ice model requires ln_blk or ln_cpl = T' ) 205 CASE( 3 ) !- LIM3 ice model 206 IF( nn_ice_embd == 0 ) CALL ctl_stop( 'sbc_init : LIM3 sea-ice models require nn_ice_embd = 1 or 2' ) 207 CASE( 4 ) !- CICE ice model 201 CASE( 2 ) !- LIM3 ice model 202 CASE( 3 ) !- CICE ice model 208 203 IF( .NOT.( ln_blk .OR. ln_cpl ) ) CALL ctl_stop( 'sbc_init : CICE sea-ice model requires ln_blk or ln_cpl = T' ) 209 IF( nn_ice_embd == 0 ) CALL ctl_stop( 'sbc_init : CICE sea-ice models require nn_ice_embd = 1 or 2' )210 204 IF( lk_agrif ) CALL ctl_stop( 'sbc_init : CICE sea-ice model not currently available with AGRIF' ) 211 205 CASE DEFAULT !- not supported 212 206 END SELECT 213 207 ! 214 IF( nn_ice == 3 ) THEN !- LIM3 case: multi-category flux option215 IF(lwp) WRITE(numout,*)216 SELECT CASE( nn_limflx ) ! LIM3 Multi-category heat flux formulation217 CASE ( -1 )218 IF(lwp) WRITE(numout,*) ' LIM3: use per-category fluxes (nn_limflx = -1) '219 IF( ln_cpl ) CALL ctl_stop( 'sbc_init : the chosen nn_limflx for LIM3 in coupled mode must be 0 or 2' )220 CASE ( 0 )221 IF(lwp) WRITE(numout,*) ' LIM3: use average per-category fluxes (nn_limflx = 0) '222 CASE ( 1 )223 IF(lwp) WRITE(numout,*) ' LIM3: use average then redistribute per-category fluxes (nn_limflx = 1) '224 IF( ln_cpl ) CALL ctl_stop( 'sbc_init : the chosen nn_limflx for LIM3 in coupled mode must be 0 or 2' )225 CASE ( 2 )226 IF(lwp) WRITE(numout,*) ' LIM3: Redistribute a single flux over categories (nn_limflx = 2) '227 IF( .NOT.ln_cpl ) CALL ctl_stop( 'sbc_init : the chosen nn_limflx for LIM3 in forced mode cannot be 2' )228 CASE DEFAULT229 CALL ctl_stop( 'sbcmod: LIM3 option, nn_limflx, should be between -1 and 2' )230 END SELECT231 ELSE ! other sea-ice model232 IF( nn_limflx >= 0 ) CALL ctl_warn( 'sbc_init : multi-category flux option (nn_limflx) only available in LIM3' )233 ENDIF234 !235 208 ! !** allocate and set required variables 236 209 ! 237 210 ! !* allocate sbc arrays 238 211 IF( sbc_oce_alloc() /= 0 ) CALL ctl_stop( 'sbc_init : unable to allocate sbc_oce arrays' ) 212 #if ! defined key_lim3 && ! defined key_cice 213 IF( sbc_ice_alloc() /= 0 ) CALL ctl_stop( 'sbc_init : unable to allocate sbc_ice arrays' ) 214 #endif 239 215 ! 240 216 IF( .NOT.ln_isf ) THEN !* No ice-shelf in the domain : allocate and set to zero … … 328 304 IF( ln_ssr ) CALL sbc_ssr_init ! Sea-Surface Restoring initialization 329 305 ! 330 IF( ln_isf ) CALL sbc_isf_init 306 IF( ln_isf ) CALL sbc_isf_init ! Compute iceshelves 331 307 ! 332 308 CALL sbc_rnf_init ! Runof initialization 333 309 ! 334 IF( nn_ice == 3 ) CALL sbc_lim_init ! LIM3 initialization 335 ! 336 IF( nn_ice == 4 ) CALL cice_sbc_init( nsbc ) ! CICE initialization 337 ! 338 IF( ln_wave ) CALL sbc_wave_init ! surface wave initialisation 310 #if defined key_lim3 311 IF ( lk_agrif .AND. nn_ice == 0 ) THEN 312 IF( sbc_ice_alloc() /= 0 ) CALL ctl_stop('STOP', 'sbc_ice_alloc : unable to allocate arrays' ) ! clem2017: allocate ice arrays in case agrif + lim + no-ice in child grid 313 ELSEIF( nn_ice == 2 ) THEN 314 CALL ice_init ! LIM3 initialization 315 ENDIF 316 #endif 317 IF( nn_ice == 3 ) CALL cice_sbc_init( nsbc ) ! CICE initialization 318 ! 319 IF( ln_wave ) CALL sbc_wave_init ! surface wave initialisation 339 320 ! 340 321 END SUBROUTINE sbc_init … … 425 406 ! 426 407 SELECT CASE( nn_ice ) ! Update heat and freshwater fluxes over sea-ice areas 427 CASE( 1 ) ; CALL sbc_ice_if ( kt ) ! Ice-cover climatology ("Ice-if" model) 428 CASE( 2 ) ; CALL sbc_ice_lim_2( kt, nsbc ) ! LIM-2 ice model 429 CASE( 3 ) ; CALL sbc_ice_lim ( kt, nsbc ) ! LIM-3 ice model 430 CASE( 4 ) ; CALL sbc_ice_cice ( kt, nsbc ) ! CICE ice model 408 CASE( 1 ) ; CALL sbc_ice_if ( kt ) ! Ice-cover climatology ("Ice-if" model) 409 #if defined key_lim3 410 CASE( 2 ) ; CALL ice_stp ( kt, nsbc ) ! LIM-3 ice model 411 #endif 412 CASE( 3 ) ; CALL sbc_ice_cice ( kt, nsbc ) ! CICE ice model 431 413 END SELECT 432 414 … … 536 518 !!--------------------------------------------------------------------- 537 519 ! 538 IF( nn_ice == 4) CALL cice_sbc_final520 IF( nn_ice == 3 ) CALL cice_sbc_final 539 521 ! 540 522 END SUBROUTINE sbc_final -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90
r8733 r8738 236 236 ENDIF 237 237 ! 238 IF( .NOT. l_ssm_mean ) THEN ! default initialisation. needed by lim_istate238 IF( .NOT. l_ssm_mean ) THEN ! default initialisation. needed by iceistate 239 239 ! 240 240 IF(lwp) WRITE(numout,*) ' default initialisation of ss._m arrays' -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90
r8733 r8738 137 137 END DO 138 138 END DO 139 CALL lbc_lnk( usd(:,:,:), 'U', vsd(:,:,:), 'V', -1. ) 139 !!gm CALL lbc_lnk( usd(:,:,:), 'U', vsd(:,:,:), 'V', -1. ) 140 CALL lbc_lnk( usd(:,:,:), 'U', -1. ) 141 CALL lbc_lnk( vsd(:,:,:), 'V', -1. ) 142 143 140 144 ! 141 145 ! !== vertical Stokes Drift 3D velocity ==! … … 152 156 END DO 153 157 ! 154 IF( .NOT. AGRIF_Root() ) THEN 155 IF( nbondi == 1 .OR. nbondi == 2 ) ze3divh(nlci-1, : ,:) = 0._wp ! east 156 IF( nbondi == -1 .OR. nbondi == 2 ) ze3divh( 2 , : ,:) = 0._wp ! west 157 IF( nbondj == 1 .OR. nbondj == 2 ) ze3divh( : ,nlcj-1,:) = 0._wp ! north 158 IF( nbondj == -1 .OR. nbondj == 2 ) ze3divh( : , 2 ,:) = 0._wp ! south 159 ENDIF 158 #if defined key_agrif 159 IF( .NOT. Agrif_Root() ) THEN 160 IF( nbondi == -1 .OR. nbondi == 2 ) ze3divh( 2:nbghostcells+1,: ,:) = 0._wp ! west 161 IF( nbondi == 1 .OR. nbondi == 2 ) ze3divh( nlci-nbghostcells:nlci-1,:,:) = 0._wp ! east 162 IF( nbondj == -1 .OR. nbondj == 2 ) ze3divh( :,2:nbghostcells+1 ,:) = 0._wp ! south 163 IF( nbondj == 1 .OR. nbondj == 2 ) ze3divh( :,nlcj-nbghostcells:nlcj-1,:) = 0._wp ! north 164 ENDIF 165 #endif 160 166 ! 161 167 CALL lbc_lnk( ze3divh, 'T', 1. ) -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
r8733 r8738 48 48 LOGICAL , PUBLIC :: ln_qsr_2bd !: 2 band light absorption flag 49 49 LOGICAL , PUBLIC :: ln_qsr_bio !: bio-model light absorption flag 50 LOGICAL , PUBLIC :: ln_qsr_ice !: light penetration for ice-model LIM3 (clem)51 50 INTEGER , PUBLIC :: nn_chldta !: use Chlorophyll data (=1) or not (=0) 52 51 REAL(wp), PUBLIC :: rn_abs !: fraction absorbed in the very near surface (RGB & 2 bands) … … 269 268 END DO 270 269 ! 271 IF( ln_qsr_ice ) THEN ! sea-ice: store the 1st ocean level attenuation coefficient 272 DO jj = 2, jpjm1 273 DO ji = fs_2, fs_jpim1 ! vector opt. 274 IF( qsr(ji,jj) /= 0._wp ) THEN ; fraqsr_1lev(ji,jj) = qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) ) 275 ELSE ; fraqsr_1lev(ji,jj) = 1._wp 276 ENDIF 277 END DO 278 END DO 279 ! Update haloes since lim_thd needs fraqsr_1lev to be defined everywhere 280 CALL lbc_lnk( fraqsr_1lev(:,:), 'T', 1._wp ) 281 ENDIF 270 ! sea-ice: store the 1st ocean level attenuation coefficient 271 DO jj = 2, jpjm1 272 DO ji = fs_2, fs_jpim1 ! vector opt. 273 IF( qsr(ji,jj) /= 0._wp ) THEN ; fraqsr_1lev(ji,jj) = qsr_hc(ji,jj,1) / ( r1_rau0_rcp * qsr(ji,jj) ) 274 ELSE ; fraqsr_1lev(ji,jj) = 1._wp 275 ENDIF 276 END DO 277 END DO 278 CALL lbc_lnk( fraqsr_1lev(:,:), 'T', 1._wp ) 282 279 ! 283 280 IF( iom_use('qsr3d') ) THEN ! output the shortwave Radiation distribution … … 336 333 TYPE(FLD_N) :: sn_chl ! informations about the chlorofyl field to be read 337 334 !! 338 NAMELIST/namtra_qsr/ sn_chl, cn_dir, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio, ln_qsr_ice,&335 NAMELIST/namtra_qsr/ sn_chl, cn_dir, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio, & 339 336 & nn_chldta, rn_abs, rn_si0, rn_si1 340 337 !!---------------------------------------------------------------------- … … 359 356 WRITE(numout,*) ' 2 band light penetration ln_qsr_2bd = ', ln_qsr_2bd 360 357 WRITE(numout,*) ' bio-model light penetration ln_qsr_bio = ', ln_qsr_bio 361 WRITE(numout,*) ' light penetration for ice-model (LIM3) ln_qsr_ice = ', ln_qsr_ice362 358 WRITE(numout,*) ' RGB : Chl data (=1) or cst value (=0) nn_chldta = ', nn_chldta 363 359 WRITE(numout,*) ' RGB & 2 bands: fraction of light (rn_si1) rn_abs = ', rn_abs -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_sbc.F90
r7753 r8738 27 27 28 28 PUBLIC usrdef_sbc_oce ! routine called in sbcmod module 29 PUBLIC usrdef_sbc_ice_tau ! routine called by sbcice_lim.F90 for ice dynamics30 PUBLIC usrdef_sbc_ice_flx ! routine called by sbcice_lim.F90 for ice thermo29 PUBLIC usrdef_sbc_ice_tau ! routine called by icestp.F90 for ice dynamics 30 PUBLIC usrdef_sbc_ice_flx ! routine called by icestp.F90 for ice thermo 31 31 32 32 !! * Substitutions -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r8733 r8738 140 140 CALL Agrif_Declare_Var_top ! " " " " " TOP 141 141 # endif 142 # if defined key_lim2143 CALL Agrif_Declare_Var_lim2 ! " " " " " LIM2144 # endif145 142 # if defined key_lim3 146 143 CALL Agrif_Declare_Var_lim3 ! " " " " " LIM3 … … 622 619 ! 623 620 IF( numstp /= -1 ) CLOSE( numstp ) ! time-step file 624 IF( num sol /= -1 ) CLOSE( numsol ) ! solverfile621 IF( numrun /= -1 ) CLOSE( numrun ) ! run statistics file 625 622 IF( numnam_ref /= -1 ) CLOSE( numnam_ref ) ! oce reference namelist 626 623 IF( numnam_cfg /= -1 ) CLOSE( numnam_cfg ) ! oce configuration namelist -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/oce.F90
r8733 r8738 65 65 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: rke !: kinetic energy 66 66 67 !! arrays relating to embedding ice in the ocean. These arrays need to be declared68 !! even if no ice model is required. In the no ice model or traditional levitating69 !! ice cases they contain only zeros70 !! ---------------------71 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: snwice_mass !: mass of snow and ice at current ice time step [Kg/m2]72 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: snwice_mass_b !: mass of snow and ice at previous ice time step [Kg/m2]73 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: snwice_fmass !: time evolution of mass of snow+ice [Kg/m2/s]74 75 67 !! Energy budget of the leads (open water embedded in sea ice) 76 68 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fraqsr_1lev !: fraction of solar net radiation absorbed in the first ocean level [-] … … 87 79 !! *** FUNCTION oce_alloc *** 88 80 !!---------------------------------------------------------------------- 89 INTEGER :: ierr( 7)81 INTEGER :: ierr(6) 90 82 !!---------------------------------------------------------------------- 91 83 ! … … 110 102 & riceload(jpi,jpj), STAT=ierr(2) ) 111 103 ! 112 ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), snwice_fmass(jpi,jpj) , STAT=ierr(3) ) 113 ! 114 ALLOCATE( fraqsr_1lev(jpi,jpj) , STAT=ierr(4) ) 104 ALLOCATE( fraqsr_1lev(jpi,jpj) , STAT=ierr(3) ) 115 105 ! 116 106 ALLOCATE( ssha_e(jpi,jpj), sshn_e(jpi,jpj), sshb_e(jpi,jpj), sshbb_e(jpi,jpj), & 117 107 & ua_e(jpi,jpj), un_e(jpi,jpj), ub_e(jpi,jpj), ubb_e(jpi,jpj), & 118 108 & va_e(jpi,jpj), vn_e(jpi,jpj), vb_e(jpi,jpj), vbb_e(jpi,jpj), & 119 & hu_e(jpi,jpj), hur_e(jpi,jpj), hv_e(jpi,jpj), hvr_e(jpi,jpj), STAT=ierr( 5) )109 & hu_e(jpi,jpj), hur_e(jpi,jpj), hv_e(jpi,jpj), hvr_e(jpi,jpj), STAT=ierr(4) ) 120 110 ! 121 ALLOCATE( ub2_b(jpi,jpj), vb2_b(jpi,jpj) , STAT=ierr( 6) )111 ALLOCATE( ub2_b(jpi,jpj), vb2_b(jpi,jpj) , STAT=ierr(5) ) 122 112 #if defined key_agrif 123 ALLOCATE( ub2_i_b(jpi,jpj), vb2_i_b(jpi,jpj) , STAT=ierr( 7) )113 ALLOCATE( ub2_i_b(jpi,jpj), vb2_i_b(jpi,jpj) , STAT=ierr(6) ) 124 114 #endif 125 115 ! -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/step.F90
r8733 r8738 61 61 !! *** ROUTINE stp *** 62 62 !! 63 !! ** Purpose : - Time stepping of OPA (momentum and active tracer eqs.)64 !! - Time stepping of LIM (dynamic and thermodynamic eqs.)65 !! - T me stepping of TRC(passive tracer eqs.)63 !! ** Purpose : - Time stepping of OPA (momentum and active tracer eqs.) 64 !! - Time stepping of ESIM (dynamic and thermodynamic eqs.) 65 !! - Time stepping of TRC (passive tracer eqs.) 66 66 !! 67 67 !! ** Method : -1- Update forcings and data -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/OPA_SRC/stpctl.F90
r8733 r8738 9 9 !! NEMO 1.0 ! 2002-06 (G. Madec) F90: Free form and module 10 10 !! 2.0 ! 2009-07 (G. Madec) Add statistic for time-spliting 11 !! 3.7 ! 2016-09 (G. Madec) Remove solver 12 !! 4.0 ! 2017-04 (G. Madec) regroup global communications 11 13 !!---------------------------------------------------------------------- 12 14 … … 21 23 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 22 24 USE lib_mpp ! distributed memory computing 23 USE lib_fortran ! Fortran routines library24 25 25 26 IMPLICIT NONE … … 28 29 PUBLIC stp_ctl ! routine called by step.F90 29 30 !!---------------------------------------------------------------------- 30 !! NEMO/OPA 3.3 , NEMO Consortium (2010)31 !! NEMO/OPA 4.0 , NEMO Consortium (2017) 31 32 !! $Id$ 32 33 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 42 43 !! ** Method : - Save the time step in numstp 43 44 !! - Print it each 50 time steps 44 !! - Stop the run IF problem ( indic < 0 ) 45 !! - Stop the run IF problem encountered by setting indic=-3 46 !! Problems checked: |ssh| maximum larger than 10 m 47 !! |U| maximum larger than 10 m/s 48 !! negative sea surface salinity 45 49 !! 46 !! ** Actions : 'time.step' file containing thelast ocean time-step47 !! 50 !! ** Actions : "time.step" file = last ocean time-step 51 !! "run.stat" file = run statistics 48 52 !!---------------------------------------------------------------------- 49 53 INTEGER, INTENT(in ) :: kt ! ocean time-step index … … 51 55 !! 52 56 INTEGER :: ji, jj, jk ! dummy loop indices 53 INTEGER :: ii, ij, ik ! local integers 54 REAL(wp) :: zumax, zsmin, zssh2, zsshmax ! local scalars 55 INTEGER, DIMENSION(3) :: ilocu ! 56 INTEGER, DIMENSION(2) :: ilocs ! 57 INTEGER :: iih, ijh ! local integers 58 INTEGER :: iiu, iju, iku ! - - 59 INTEGER :: iis, ijs ! - - 60 REAL(wp) :: zzz ! local real 61 INTEGER , DIMENSION(3) :: ilocu 62 INTEGER , DIMENSION(2) :: ilocs, iloch 63 REAL(wp), DIMENSION(3) :: zmax 57 64 !!---------------------------------------------------------------------- 58 65 ! … … 61 68 WRITE(numout,*) 'stp_ctl : time-stepping control' 62 69 WRITE(numout,*) '~~~~~~~' 63 ! open time.step file70 ! ! open time.step file 64 71 CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 72 ! ! open run.stat file 73 CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 65 74 ENDIF 66 75 ! 67 IF(lwp) WRITE ( numstp, '(1x, i8)' ) kt !* save the current time step in numstp 68 IF(lwp) REWIND( numstp ) ! -------------------------- 76 IF(lwp) THEN !== current time step ==! ("time.step" file) 77 WRITE ( numstp, '(1x, i8)' ) kt 78 REWIND( numstp ) 79 ENDIF 69 80 ! 70 ! !* Test maximum of velocity (zonal only) 71 ! ! ------------------------ 72 !! zumax = MAXVAL( ABS( un(:,:,:) ) ) ! slower than the following loop on NEC SX5 73 zumax = 0.e0 74 DO jk = 1, jpk 75 DO jj = 1, jpj 76 DO ji = 1, jpi 77 zumax = MAX(zumax,ABS(un(ji,jj,jk))) 78 END DO 79 END DO 80 END DO 81 IF( lk_mpp ) CALL mpp_max( zumax ) ! max over the global domain 81 ! !== test of extrema ==! 82 zmax(1) = MAXVAL( ABS( sshn(:,:) ) ) ! ssh max 83 zmax(2) = MAXVAL( ABS( un(:,:,:) ) ) ! velocity max (zonal only) 84 zmax(3) = MAXVAL( -tsn(:,:,1,jp_sal) , mask = tmask(:,:,1) == 1._wp ) ! minus surface salinity max 82 85 ! 83 IF( MOD( kt, nwrite ) == 1 .AND. lwp ) WRITE(numout,*) ' ==>> time-step= ',kt,' abs(U) max: ', zumax86 IF( lk_mpp ) CALL mpp_max_multiple( zmax(:), 3 ) ! max over the global domain 84 87 ! 85 IF( zumax > 20.e0 ) THEN 88 IF( MOD( kt, nwrite ) == 1 .AND. lwp ) THEN 89 WRITE(numout,*) ' ==>> time-step= ', kt, ' |ssh| max: ', zmax(1), ' |U| max: ', zmax(2), & 90 & ' SSS min: ' , - zmax(3) 91 ENDIF 92 ! 93 IF ( zmax(1) > 10._wp .OR. & ! too large sea surface height ( > 10 m) 94 & zmax(2) > 10._wp .OR. & ! too large velocity ( > 10 m/s) 95 & zmax(3) > 0._wp ) THEN ! negative sea surface salinity 86 96 IF( lk_mpp ) THEN 87 CALL mpp_maxloc(ABS(un),umask,zumax,ii,ij,ik) 97 CALL mpp_maxloc( ABS(sshn) , tmask(:,:,1), zzz, iih, ijh ) 98 CALL mpp_maxloc( ABS(un) , umask , zzz, iiu, iju, iku ) 99 CALL mpp_minloc( tsn(:,:,1,jp_sal), tmask(:,:,1), zzz, iis, ijs ) 88 100 ELSE 101 iloch = MINLOC( ABS( sshn(:,:) ) ) 89 102 ilocu = MAXLOC( ABS( un(:,:,:) ) ) 90 ii = ilocu(1) + nimpp - 1 91 ij = ilocu(2) + njmpp - 1 92 ik = ilocu(3) 103 ilocs = MINLOC( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1._wp ) 104 iih = iloch(1) + nimpp - 1 ; ijh = iloch(2) + njmpp - 1 105 iiu = ilocu(1) + nimpp - 1 ; iju = ilocu(2) + njmpp - 1 ; iku = ilocu(3) 106 iis = ilocs(1) + nimpp - 1 ; ijs = ilocs(2) + njmpp - 1 93 107 ENDIF 94 108 IF(lwp) THEN 95 109 WRITE(numout,cform_err) 96 WRITE(numout,*) ' stpctl: the zonal velocity is larger than 20 m/s'110 WRITE(numout,*) ' stpctl: |ssh| > 10 m or |U| > 10 m/s or SSS < 0' 97 111 WRITE(numout,*) ' ====== ' 98 WRITE(numout,9400) kt, zumax, ii, ij, ik 112 WRITE(numout,9100) kt, zmax(1), iih, ijh 113 WRITE(numout,9200) kt, zmax(2), iiu, iju, iku 114 WRITE(numout,9300) kt, - zmax(3), iis, ijs 99 115 WRITE(numout,*) 100 WRITE(numout,*) ' output of last fields in numwso'116 WRITE(numout,*) ' output of last computed fields in output.abort.nc file' 101 117 ENDIF 102 118 kindic = -3 103 119 ENDIF 104 9400 FORMAT (' kt=',i6,' max abs(U): ',1pg11.4,', i j k: ',3i5) 120 9100 FORMAT (' kt=',i8,' |ssh| max: ',1pg11.4,', at i j : ',2i5) 121 9200 FORMAT (' kt=',i8,' |U| max: ',1pg11.4,', at i j k: ',3i5) 122 9300 FORMAT (' kt=',i8,' SSS min: ',1pg11.4,', at i j : ',2i5) 105 123 ! 106 ! !* Test minimum of salinity 107 ! ! ------------------------ 108 !! zsmin = MINVAL( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1.e0 ) slower than the following loop on NEC SX5 109 zsmin = 100._wp 110 DO jj = 2, jpjm1 111 DO ji = 1, jpi 112 IF( tmask(ji,jj,1) == 1) zsmin = MIN(zsmin,tsn(ji,jj,1,jp_sal)) 113 END DO 114 END DO 115 IF( lk_mpp ) CALL mpp_min( zsmin ) ! min over the global domain 124 ! !== run statistics ==! ("run.stat" file) 125 IF(lwp) WRITE(numrun,9400) kt, zmax(1), zmax(2), - zmax(3) 116 126 ! 117 IF( MOD( kt, nwrite ) == 1 .AND. lwp ) WRITE(numout,*) ' ==>> time-step= ',kt,' SSS min:', zsmin 118 ! 119 IF( zsmin < 0.) THEN 120 IF (lk_mpp) THEN 121 CALL mpp_minloc ( tsn(:,:,1,jp_sal),tmask(:,:,1), zsmin, ii,ij ) 122 ELSE 123 ilocs = MINLOC( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1.e0 ) 124 ii = ilocs(1) + nimpp - 1 125 ij = ilocs(2) + njmpp - 1 126 ENDIF 127 ! 128 IF(lwp) THEN 129 WRITE(numout,cform_err) 130 WRITE(numout,*) 'stp_ctl : NEGATIVE sea surface salinity' 131 WRITE(numout,*) '======= ' 132 WRITE(numout,9500) kt, zsmin, ii, ij 133 WRITE(numout,*) 134 WRITE(numout,*) ' output of last fields in numwso' 135 ENDIF 136 kindic = -3 137 ENDIF 138 9500 FORMAT (' kt=',i6,' min SSS: ',1pg11.4,', i j: ',2i5) 139 ! 140 ! 141 IF( lk_c1d ) RETURN ! No log file in case of 1D vertical configuration 142 143 ! log file (ssh statistics) 144 ! -------- !* ssh statistics (and others...) 145 IF( kt == nit000 .AND. lwp ) THEN ! open ssh statistics file (put in solver.stat file) 146 CALL ctl_opn( numsol, 'solver.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 147 ENDIF 148 ! 149 zsshmax = 0.e0 150 DO jj = 1, jpj 151 DO ji = 1, jpi 152 IF( tmask(ji,jj,1) == 1) zsshmax = MAX( zsshmax, ABS(sshn(ji,jj)) ) 153 END DO 154 END DO 155 IF( lk_mpp ) CALL mpp_max( zsshmax ) ! min over the global domain 156 ! 157 IF( MOD( kt, nwrite ) == 1 .AND. lwp ) WRITE(numout,*) ' ==>> time-step= ',kt,' ssh max:', zsshmax 158 ! 159 IF( zsshmax > 10.e0 ) THEN 160 IF (lk_mpp) THEN 161 CALL mpp_maxloc( ABS(sshn(:,:)),tmask(:,:,1),zsshmax,ii,ij) 162 ELSE 163 ilocs = MAXLOC( ABS(sshn(:,:)) ) 164 ii = ilocs(1) + nimpp - 1 165 ij = ilocs(2) + njmpp - 1 166 ENDIF 167 ! 168 IF(lwp) THEN 169 WRITE(numout,cform_err) 170 WRITE(numout,*) 'stp_ctl : the ssh is larger than 10m' 171 WRITE(numout,*) '======= ' 172 WRITE(numout,9600) kt, zsshmax, ii, ij 173 WRITE(numout,*) 174 WRITE(numout,*) ' output of last fields in numwso' 175 ENDIF 176 kindic = -3 177 ENDIF 178 9600 FORMAT (' kt=',i6,' max ssh: ',1pg11.4,', i j: ',2i5) 179 ! 180 zssh2 = glob_sum( sshn(:,:) * sshn(:,:) ) 181 ! 182 IF(lwp) WRITE(numsol,9700) kt, zssh2, zumax, zsmin ! ssh statistics 183 ! 184 9700 FORMAT(' it :', i8, ' ssh2: ', d23.16, ' Umax: ',d23.16,' Smin: ',d23.16) 127 9400 FORMAT(' it :', i8, ' |ssh|_max: ', e16.10, ' |U|_max: ',e16.10,' SSS_min: ',e16.10) 185 128 ! 186 129 END SUBROUTINE stp_ctl -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAS_SRC/diawri.F90
r8733 r8738 38 38 USE iom 39 39 USE ioipsl 40 #if defined key_lim2 41 USE limwri_2 42 #elif defined key_lim3 43 USE limwri 40 #if defined key_lim3 41 USE icewri 44 42 #endif 45 43 USE lib_mpp ! MPP library … … 397 395 & jpi, jpj, nh_i, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 398 396 399 #if defined key_lim 2400 CALL lim_wri_state_2( kt, id_i, nh_i )401 #elif defined key_lim3 402 CALL lim_wri_state( kt, id_i, nh_i )397 #if defined key_lim3 398 IF( nn_ice == 2 ) THEN ! clem2017: condition in case agrif + lim but no-ice in child grid 399 CALL ice_wri_state( kt, id_i, nh_i ) 400 ENDIF 403 401 #else 404 402 CALL histend( id_i, snc4chunks=snc4set ) -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90
r8733 r8738 86 86 CALL Agrif_Declare_Var_top ! " " " " " TOP 87 87 # endif 88 # if defined key_lim289 CALL Agrif_Declare_Var_lim2 ! " " " " " LIM90 # endif91 88 # if defined key_lim3 92 89 CALL Agrif_Declare_Var_lim3 ! " " " " " LIM3 … … 134 131 ! 135 132 #if defined key_agrif 136 IF( .NOT. Agrif_Root() ) THEN133 !!clem2017 IF( .NOT. Agrif_Root() ) THEN 137 134 CALL Agrif_ParentGrid_To_ChildGrid() 138 135 IF( nn_timing == 1 ) CALL timing_finalize 139 136 CALL Agrif_ChildGrid_To_ParentGrid() 140 ENDIF137 !!clem2017 ENDIF 141 138 #endif 142 139 IF( nn_timing == 1 ) CALL timing_finalize … … 513 510 ierr = dia_wri_alloc () 514 511 ierr = ierr + dom_oce_alloc () ! ocean domain 515 ierr = ierr + oce_alloc () ! (tsn...) needed for agrif and/or lim3and bdy512 ierr = ierr + oce_alloc () ! (tsn...) needed for agrif and/or ESIM and bdy 516 513 ierr = ierr + bdy_oce_alloc () ! bdy masks (incl. initialization) 517 514 ! -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90
r8733 r8738 115 115 ELSE 116 116 sst_m(:,:) = 0._wp 117 sss_m(:,:) = 0._wp117 sss_m(:,:) = 35._wp 118 118 ssu_m(:,:) = 0._wp 119 119 ssv_m(:,:) = 0._wp … … 313 313 ENDIF 314 314 315 CALL sbc_ssm( nit000 ) ! need to define ss?_m arrays used in limistate315 CALL sbc_ssm( nit000 ) ! need to define ss?_m arrays used in iceistate 316 316 l_initdone = .TRUE. 317 317 ! -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/SAS_SRC/step.F90
r8733 r8738 24 24 USE diawri ! Standard run outputs (dia_wri routine) 25 25 USE bdy_oce , ONLY: ln_bdy 26 USE bdydta ! clem: mandatory for LIM326 USE bdydta ! clem: mandatory for ESIM 27 27 USE stpctl ! time stepping control (stp_ctl routine) 28 28 ! … … 89 89 CALL iom_setkt( kstp - nit000 + 1, cxios_context ) ! tell iom we are at time step kstp 90 90 91 ! ==> clem: open boundaries is mandatory for LIM3because ice BDY is not decoupled from91 ! ==> clem: open boundaries is mandatory for ESIM because ice BDY is not decoupled from 92 92 ! the environment of ocean BDY. Therefore bdy is called in both OPA and SAS modules. 93 93 ! From SAS: ocean bdy data are wrong (but we do not care) and ice bdy data are OK. -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
r8733 r8738 63 63 INTEGER :: ji, jj, jn ! dummy loop indices 64 64 REAL(wp) :: zse3t, zrtrn, zratio, zfact ! temporary scalars 65 REAL(wp) :: z switch, zftra, zcd, zdtra, ztfx, ztra! temporary scalars65 REAL(wp) :: zftra, zcd, zdtra, ztfx, ztra ! temporary scalars 66 66 CHARACTER (len=22) :: charout 67 67 REAL(wp), POINTER, DIMENSION(:,: ) :: zsfx … … 77 77 ! 78 78 zrtrn = 1.e-15_wp 79 80 SELECT CASE( nn_ice_embd ) ! levitating or embedded sea-ice option81 CASE( 0 ) ; zswitch = 1 ! (0) standard levitating sea-ice : salt exchange only82 CASE( 1, 2 ) ; zswitch = 0 ! (1) levitating sea-ice: salt and volume exchange but no pressure effect83 ! ! (2) embedded sea-ice : salt and volume fluxes and pressure84 END SELECT85 79 86 80 IF( kt == nittrc000 ) THEN … … 145 139 ! tracer flux only : add concentration dilution term in net tracer flux, no F-M in volume flux 146 140 ! tracer and mass fluxes : no concentration dilution term in net tracer flux, F-M term in volume flux 147 ztfx = zftra + zswitch * zcd ! net tracer flux (+C/D if no ice/ocean mass exchange)141 ztfx = zftra ! net tracer flux 148 142 149 143 zdtra = r1_rau0 * ( ztfx + zsfx(ji,jj) * trn(ji,jj,1,jn) ) -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90
r8733 r8738 63 63 USE sbc_oce , ONLY : ln_rnf => ln_rnf !: runoffs / runoff mouths 64 64 USE sbc_oce , ONLY : fr_i => fr_i !: ice fraction (between 0 to 1) 65 USE sbc_oce , ONLY : nn_ice_embd => nn_ice_embd !: flag for levitating/embedding sea-ice in the ocean66 65 USE sbc_oce , ONLY : atm_co2 => atm_co2 ! atmospheric pCO2 67 66 USE traqsr , ONLY : rn_abs => rn_abs !: fraction absorbed in the very near surface -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/TOP_SRC/trc.F90
r8733 r8738 172 172 CHARACTER(len=20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: cn_trc ! Choice of boundary condition for tracers 173 173 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: nn_trcdmp_bdy !: =T Tracer damping 174 !$AGRIF_DO_NOT_TREAT 174 175 ! External data structure of BDY for TOP. Available elements: cn_obc, ll_trc, trcnow, dmp 175 176 TYPE(OBC_DATA), PUBLIC, ALLOCATABLE, DIMENSION(:,:), TARGET :: trcdta_bdy !: bdy external data (local process) 176 ! 177 177 !$AGRIF_END_DO_NOT_TREAT 178 178 !!---------------------------------------------------------------------- 179 179 !! NEMO/TOP 3.3.1 , NEMO Consortium (2010) -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_ADA
r7715 r8738 11 11 # @ total_tasks = NPROCS 12 12 # time 13 # @ wall_clock_limit = 1:30:0013 # @ wall_clock_limit = 00:59:00 14 14 # @ queue 15 15 -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-X64_MOBILIS
r7646 r8738 8 8 module load intel/compiler/64/14.0/2013_sp1.2.144 9 9 module load openmpi/intel/64/1.6.5 10 module load slurm/ 2.5.710 module load slurm/16.05.8 11 11 12 12 # -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/README
r7646 r8738 45 45 INPUT_DIR : directory in which store input files (tar file) 46 46 TMPDIR : temporary directory NEEDED ONLY FOR IBM machines (put EXP00 directory) 47 NEMO_VALIDATION_DIR : directory in which create NEMO_VALIDATION tree, and store restart, solver.stat, tracer.stat and ocean.output files in47 NEMO_VALIDATION_DIR : directory in which create NEMO_VALIDATION tree, and store restart, run.stat, tracer.stat and ocean.output files in 48 48 tree NEMO_VALIDATION_DIR/WCONFIG_NAME/WCOMPILER_NAME/TEST_NAME/REVISION_NUMBER(or DATE) 49 49 in fcm_job.sh : -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/all_functions.sh
r8733 r8738 219 219 fi 220 220 # Save output & debug files in NEMO_VALIDATION tree 221 echo "saving ocean & ice output, solver.stat, tracer.stat files ...." >> ${SETTE_DIR}/output.sette221 echo "saving ocean & ice output, run.stat, tracer.stat files ...." >> ${SETTE_DIR}/output.sette 222 222 echo " " >> ${SETTE_DIR}/output.sette 223 223 [ -f ${EXE_DIR}/ocean.output ] && cp ${EXE_DIR}/*ocean.output ${NEMO_VALID}/. 224 [ -f ${EXE_DIR}/ solver.stat ] && cp ${EXE_DIR}/*solver.stat ${NEMO_VALID}/.224 [ -f ${EXE_DIR}/run.stat ] && cp ${EXE_DIR}/*run.stat ${NEMO_VALID}/. 225 225 [ -f ${EXE_DIR}/output.namelist.dyn ] && cp ${EXE_DIR}/*output.nam* ${NEMO_VALID}/. 226 226 [ -f ${EXE_DIR}/tracer.stat ] && cp ${EXE_DIR}/*tracer.stat ${NEMO_VALID}/. 227 227 228 if [ -n "$(ls ${NEMO_VALID}/* solver*)" ] ; then229 echo "moved solver.stat in ${NEMO_VALID} directory" >> ${SETTE_DIR}/output.sette230 echo "moved solver.stat in ${NEMO_VALID} directory"228 if [ -n "$(ls ${NEMO_VALID}/*run*)" ] ; then 229 echo "moved run.stat in ${NEMO_VALID} directory" >> ${SETTE_DIR}/output.sette 230 echo "moved run.stat in ${NEMO_VALID} directory" 231 231 else 232 echo "problem in looking for solver.stat file in ${NEMO_VALID} directory" >> ${SETTE_DIR}/output.sette233 echo " solver.stat IS NOT in ${NEMO_VALID} directory"232 echo "problem in looking for run.stat file in ${NEMO_VALID} directory" >> ${SETTE_DIR}/output.sette 233 echo "run.stat IS NOT in ${NEMO_VALID} directory" 234 234 fi 235 235 if [ -n "$(ls ${NEMO_VALID}/*ocean.output*)" ] ; then -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/sette.sh
r7756 r8738 56 56 # set_namelist : function declared in all_functions that sets namelist parameters 57 57 # post_test_tidyup : creates validation storage directory and copies required output files 58 # ( solver.stat and ocean.output) in it after execution of test.58 # (run.stat and ocean.output) in it after execution of test. 59 59 # 60 60 # VALIDATION tree is: … … 137 137 # ORCA2_OFF_PISCES : 5 & 6 138 138 # AMM12 : 7 & 8 139 # SAS : 9 fos SAS there is no solverso is useless to test REPRO139 # SAS : 9 fos SAS there is no run.stat so is useless to test REPRO 140 140 # ISOMIP : 10 & 11 141 141 # ORCA2_LIM3_OBS : 12 … … 143 143 # 15 & 16 144 144 145 for config in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 145 for config in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 146 146 147 147 do … … 312 312 set_namelist namelist_cfg jpnj 8 313 313 set_namelist namelist_cfg jpnij 32 314 set_namelist namelist_ice_cfg ln_icediachk .true. 315 ## set_namelist namelist_ice_cfg ln_icediahsb .true. 314 316 set_namelist namelist_top_cfg ln_trcdta .false. 315 317 # put ln_ironsed, ln_river, ln_ndepo, ln_dust to false … … 350 352 set_namelist namelist_cfg jpnj 8 351 353 set_namelist namelist_cfg jpnij 32 354 set_namelist namelist_ice_cfg ln_icediachk .true. 355 ## set_namelist namelist_ice_cfg ln_icediahsb .true. 352 356 set_namelist namelist_top_cfg ln_rsttr .true. 353 357 set_namelist namelist_top_cfg nn_rsttr 2 … … 411 415 set_namelist namelist_cfg jpnj 8 412 416 set_namelist namelist_cfg jpnij 32 417 set_namelist namelist_ice_cfg ln_icediachk .true. 418 set_namelist namelist_ice_cfg ln_icediahsb .true. 413 419 set_namelist namelist_top_cfg ln_trcdta .false. 414 420 # put ln_ironsed, ln_river, ln_ndepo, ln_dust to false … … 452 458 set_namelist namelist_cfg jpnj 4 453 459 set_namelist namelist_cfg jpnij 32 460 set_namelist namelist_ice_cfg ln_icediachk .true. 461 set_namelist namelist_ice_cfg ln_icediahsb .true. 454 462 set_namelist namelist_top_cfg ln_trcdta .false. 455 463 # put ln_ironsed, ln_river, ln_ndepo, ln_dust to false … … 661 669 export TEST_NAME="LONG" 662 670 cd ${CONFIG_DIR0} 663 . ./makenemo -m ${CMP_NAM} -n AMM12_LONG -r AMM12 -j 8 add_key "key_tide"del_key ${DEL_KEYS}671 . ./makenemo -m ${CMP_NAM} -n AMM12_LONG -r AMM12 -j 8 del_key ${DEL_KEYS} 664 672 cd ${SETTE_DIR} 665 673 . ./param.cfg … … 810 818 set_namelist namelist_cfg jpnj 8 811 819 set_namelist namelist_cfg jpnij 32 820 set_namelist namelist_ice_cfg ln_icediachk .true. 812 821 if [ ${USING_MPMD} == "yes" ] ; then 813 822 set_xio_using_server iodef.xml true … … 835 844 set_namelist namelist_cfg ln_rstart .true. 836 845 set_namelist namelist_cfg nn_rstctl 2 846 set_namelist namelist_ice_cfg ln_icediachk .true. 837 847 set_namelist namelist_ice_cfg cn_icerst_in \"SAS_00000050_restart_ice\" 838 848 if [ ${USING_MPMD} == "yes" ] ; then … … 1121 1131 set_namelist 1_namelist_cfg nn_it000 1 1122 1132 set_namelist 1_namelist_cfg nn_itend 150 1133 set_namelist 1_namelist_cfg nn_fsbc 1 1123 1134 set_namelist 1_namelist_cfg ln_ctl .false. 1124 1135 set_namelist 1_namelist_cfg ln_clobber .true. … … 1219 1230 export TEST_NAME="LONG" 1220 1231 cd ${CONFIG_DIR0} 1221 . ./makenemo -m ${CMP_NAM} -n ORCA2AGUL_LONG -r ORCA2_LIM3_PISCES -d "OPA_SRC LIM_SRC_3 NST_SRC" -j 8 add_key "key_agrif " del_key "key_zdftmxkey_top"1232 . ./makenemo -m ${CMP_NAM} -n ORCA2AGUL_LONG -r ORCA2_LIM3_PISCES -d "OPA_SRC LIM_SRC_3 NST_SRC" -j 8 add_key "key_agrif key_zdftmx" del_key "key_zdftmx_new key_top" 1222 1233 cd ${SETTE_DIR} 1223 1234 . ./param.cfg … … 1245 1256 set_namelist 1_namelist_cfg nn_itend 300 1246 1257 set_namelist 1_namelist_cfg nn_stock 150 1258 set_namelist 1_namelist_cfg nn_fsbc 1 1247 1259 set_namelist 1_namelist_cfg ln_ctl .false. 1248 1260 set_namelist 1_namelist_cfg ln_clobber .true. … … 1283 1295 set_namelist 1_namelist_cfg nn_itend 300 1284 1296 set_namelist 1_namelist_cfg nn_stock 150 1297 set_namelist 1_namelist_cfg nn_fsbc 1 1285 1298 set_namelist 1_namelist_cfg ln_rstart .true. 1286 1299 set_namelist 1_namelist_cfg nn_rstctl 2 … … 1293 1306 set_namelist namelist_ice_cfg cn_icerst_in \"O2LP_LONG_00000075_restart_ice\" 1294 1307 set_namelist 1_namelist_cfg cn_ocerst_in \"O2LP_LONG_00000150_restart\" 1308 set_namelist 1_namelist_ice_cfg cn_icerst_in \"O2LP_LONG_00000150_restart_ice\" 1295 1309 1296 1310 for (( i=1; i<=$NPROC; i++)) ; do … … 1300 1314 ln -sf ../LONG/O2LP_LONG_00000075_restart_ice_${L_NPROC}.nc . 1301 1315 ln -sf ../LONG/1_O2LP_LONG_00000150_restart_${L_NPROC}.nc . 1316 ln -sf ../LONG/1_O2LP_LONG_00000150_restart_ice_${L_NPROC}.nc . 1302 1317 done 1303 1318 if [ ${USING_MPMD} == "yes" ] ; then … … 1316 1331 export TEST_NAME="REPRO_4_4" 1317 1332 cd ${CONFIG_DIR0} 1318 . ./makenemo -m ${CMP_NAM} -n ORCA2AGUL_16 -r ORCA2_LIM3_PISCES -d "OPA_SRC LIM_SRC_3 NST_SRC" -j 8 add_key "key_agrif " del_key "key_zdftmxkey_top"1333 . ./makenemo -m ${CMP_NAM} -n ORCA2AGUL_16 -r ORCA2_LIM3_PISCES -d "OPA_SRC LIM_SRC_3 NST_SRC" -j 8 add_key "key_agrif key_zdftmx" del_key "key_zdftmx_new key_top" 1319 1334 cd ${SETTE_DIR} 1320 1335 . ./param.cfg … … 1339 1354 set_namelist 1_namelist_cfg nn_it000 1 1340 1355 set_namelist 1_namelist_cfg nn_itend 150 1356 set_namelist 1_namelist_cfg nn_fsbc 1 1341 1357 set_namelist 1_namelist_cfg ln_ctl .false. 1342 1358 set_namelist 1_namelist_cfg ln_clobber .true. … … 1378 1394 set_namelist 1_namelist_cfg nn_itend 150 1379 1395 set_namelist 1_namelist_cfg ln_ctl .false. 1396 set_namelist 1_namelist_cfg nn_fsbc 1 1380 1397 set_namelist 1_namelist_cfg ln_clobber .true. 1381 1398 set_namelist 1_namelist_cfg ln_read_cfg .true. -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/sette_beginner.sh
r4796 r8738 55 55 # set_namelist : function declared in all_functions that sets namelist parameters 56 56 # post_test_tidyup : creates validation storage directory and copies required output files 57 # ( solver.stat and ocean.output) in it after execution of test.57 # (run.stat and ocean.output) in it after execution of test. 58 58 # 59 59 # VALIDATION tree is: -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/sette_rpt.sh
r7715 r8738 1 1 #!/bin/bash -f 2 2 # 3 # set -vx 3 4 # simple SETTE report generator. 4 5 # … … 23 24 dorv=`echo $dorv | sed -e 's:.*/::'` 24 25 f1o=$vdir/$nam/$mach/$dorv/LONG/ocean.output 25 f1s=$vdir/$nam/$mach/$dorv/LONG/ solver.stat26 f1s=$vdir/$nam/$mach/$dorv/LONG/run.stat 26 27 f1t=$vdir/$nam/$mach/$dorv/LONG/tracer.stat 27 28 f2o=$vdir/$nam/$mach/$dorv/SHORT/ocean.output 28 f2s=$vdir/$nam/$mach/$dorv/SHORT/ solver.stat29 f2s=$vdir/$nam/$mach/$dorv/SHORT/run.stat 29 30 f2t=$vdir/$nam/$mach/$dorv/SHORT/tracer.stat 30 31 … … 46 47 if [ $? == 0 ]; then 47 48 if [ $pass == 0 ]; then 48 printf "%-20s %s %s\n" $nam " solver.statrestartability passed : " $dorv49 fi 50 else 51 printf "%-20s %s %s\n" $nam " solver.statrestartability FAILED : " $dorv52 # 53 # Offer view of differences on the second pass 54 # 55 if [ $pass == 1 ]; then 56 echo "<return> to view solver.stat differences"49 printf "%-20s %s %s\n" $nam " run.stat restartability passed : " $dorv 50 fi 51 else 52 printf "%-20s %s %s\n" $nam " run.stat restartability FAILED : " $dorv 53 # 54 # Offer view of differences on the second pass 55 # 56 if [ $pass == 1 ]; then 57 echo "<return> to view run.stat differences" 57 58 read y 58 59 sdiff f1.tmp$$ $f2s … … 118 119 rep2=`ls -1rt $vdir/$nam/$mach/$dorv/ | tail -1l` 119 120 f1o=$vdir/$nam/$mach/$dorv/$rep1/ocean.output 120 f1s=$vdir/$nam/$mach/$dorv/$rep1/ solver.stat121 f1s=$vdir/$nam/$mach/$dorv/$rep1/run.stat 121 122 f1t=$vdir/$nam/$mach/$dorv/$rep1/tracer.stat 122 123 f2o=$vdir/$nam/$mach/$dorv/$rep2/ocean.output 123 f2s=$vdir/$nam/$mach/$dorv/$rep2/ solver.stat124 f2s=$vdir/$nam/$mach/$dorv/$rep2/run.stat 124 125 f2t=$vdir/$nam/$mach/$dorv/$rep2/tracer.stat 125 126 … … 139 140 if [ $? == 0 ]; then 140 141 if [ $pass == 0 ]; then 141 printf "%-20s %s %s\n" $nam " solver.statreproducibility passed : " $dorv142 fi 143 else 144 printf "%-20s %s %s\n" $nam " solver.statreproducibility FAILED : " $dorv145 # 146 # Offer view of differences on the second pass 147 # 148 if [ $pass == 1 ]; then 149 echo "<return> to view solver.stat differences"142 printf "%-20s %s %s\n" $nam " run.stat reproducibility passed : " $dorv 143 fi 144 else 145 printf "%-20s %s %s\n" $nam " run.stat reproducibility FAILED : " $dorv 146 # 147 # Offer view of differences on the second pass 148 # 149 if [ $pass == 1 ]; then 150 echo "<return> to view run.stat differences" 150 151 read y 151 152 sdiff f1.tmp$$ $f2s … … 199 200 mach=`grep "COMPILER=" ./sette.sh | sed -e 's/COMPILER=//'` 200 201 NEMO_VALID=`grep "NEMO_VALIDATION_DIR=" ./param.cfg | sed -e 's/NEMO_VALIDATION_DIR=//'` 202 NEMO_VALID=`eval "echo $NEMO_VALID"` 201 203 # 202 204 if [ ! -d $NEMO_VALID ]; then -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/SETTE/sette_xios.sh
r4990 r8738 52 52 # set_namelist : function declared in all_functions that sets namelist parameters 53 53 # post_test_tidyup : creates validation storage directory and copies required output files 54 # ( solver.stat and ocean.output) in it after execution of test.54 # (run.stat and ocean.output) in it after execution of test. 55 55 # 56 56 # VALIDATION tree is: -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/COMPILE/Fadd_keys.sh
r7646 r8738 65 65 echo "Adding keys in : ${NEW_CONF}" 66 66 for i in ${list_add_key} ; do 67 if [ "$(cat ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm | grep -c " $i" )" -ne 0 ] ; then67 if [ "$(cat ${CONFIG_DIR}/${NEW_CONF}/cpp_${NEW_CONF}.fcm | grep -c "\<$i\>" )" -ne 0 ] ; then 68 68 echo "key $i already present in cpp_${NEW_CONF}.fcm" 69 69 else -
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/TOOLS/DOMAINcfg/namelist_ref
r7200 r8738 278 278 ! = 2 Redistribute a single flux over categories (coupled mode only) 279 279 ! Sea-ice : 280 nn_ice = 2! =0 no ice boundary condition ,280 nn_ice = 3 ! =0 no ice boundary condition , 281 281 ! =1 use observed ice-cover , 282 ! = 2 ice-model used ("key_lim3", "key_lim2", "key_cice")282 ! =3-4 ice-model used ("key_lim3", "key_cice") 283 283 nn_ice_embd = 1 ! =0 levitating ice (no mass exchange, concentration/dilution effect) 284 284 ! =1 levitating ice with mass and salt exchange but no presure effect … … 670 670 bn_tem = 'amm12_bdyT_tra', 24 , 'votemper', .true. , .false. , 'daily' , '' , '' , '' 671 671 bn_sal = 'amm12_bdyT_tra', 24 , 'vosaline', .true. , .false. , 'daily' , '' , '' , '' 672 ! for lim2673 ! bn_frld = 'amm12_bdyT_ice', 24 , 'ileadfra', .true. , .false. , 'daily' , '' , '' , ''674 ! bn_hicif = 'amm12_bdyT_ice', 24 , 'iicethic', .true. , .false. , 'daily' , '' , '' , ''675 ! bn_hsnif = 'amm12_bdyT_ice', 24 , 'isnowthi', .true. , .false. , 'daily' , '' , '' , ''676 672 ! for lim3 677 673 ! bn_a_i = 'amm12_bdyT_ice', 24 , 'ileadfra', .true. , .false. , 'daily' , '' , '' , ''
Note: See TracChangeset
for help on using the changeset viewer.