Changeset 5350 for branches/2014/dev_r5134_UKMO4_CF_compliance
- Timestamp:
- 2015-06-04T16:12:19+02:00 (9 years ago)
- Location:
- branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM
- Files:
-
- 3 deleted
- 199 edited
- 7 copied
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/ARCH/INGV/arch-IBM_EKMAN_INGV.fcm
r5094 r5350 18 18 %NCDF_INC -I/srv/lib/netcdf-x/include 19 19 %NCDF_LIB -L/srv/lib/netcdf-x/lib -lnetcdff -lnetcdf -lhdf5_hl -lhdf5 -lcurl -lstdc++ 20 %XIOS_ROOT /home/delrosso/XIOS_ 482/XIOS20 %XIOS_ROOT /home/delrosso/XIOS_1.0/xios-1.0 21 21 %MPI_INTEL -I/srv/intel/impi/4.1.0.024/include 22 22 %CPP cpp -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/CONFIG/AMM12/EXP00/namelist_cfg
r5109 r5350 394 394 &namptr ! Poleward Transport Diagnostic 395 395 !----------------------------------------------------------------------- 396 ln_diaznl = .false. ! Add zonal means and meridional stream functions 397 ln_subbas = .false. ! Atlantic/Pacific/Indian basins computation (T) or not 398 ! (orca configuration only, need input basins mask file named "subbasins.nc" 399 ln_ptrcomp = .false. ! Add decomposition : overturning 400 / 401 !----------------------------------------------------------------------- 396 / 402 397 &namhsb ! Heat and salt budgets 403 398 !----------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/namelist_cfg
r5102 r5350 195 195 &nameos ! ocean physical parameters 196 196 !----------------------------------------------------------------------- 197 nn_eos = 2! type of equation of state and Brunt-Vaisala frequency197 nn_eos = 0 ! type of equation of state and Brunt-Vaisala frequency 198 198 / 199 199 !----------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh.500yfwb0
r4394 r5350 114 114 export VAR1_Ithick V1It_PREF V1It_SUFF 115 115 export VAR1_SNOW V1SNOW_PREF V1SNOW_SUFF 116 export VAR1_IvelV V1IvV_PREF V1IvV_ PREF116 export VAR1_IvelV V1IvV_PREF V1IvV_SUFF 117 117 #===================== EXP2 ===================== 118 118 export DATE1_2 DATE2_2 … … 127 127 export VAR2_Ithick V2It_PREF V2It_SUFF 128 128 export VAR2_SNOW V2SNOW_PREF V2SNOW_SUFF 129 export VAR2_IvelV V2IvV_PREF V2IvV_ PREF129 export VAR2_IvelV V2IvV_PREF V2IvV_SUFF 130 130 # -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh.500yfwb2
r4394 r5350 114 114 export VAR1_Ithick V1It_PREF V1It_SUFF 115 115 export VAR1_SNOW V1SNOW_PREF V1SNOW_SUFF 116 export VAR1_IvelV V1IvV_PREF V1IvV_ PREF116 export VAR1_IvelV V1IvV_PREF V1IvV_SUFF 117 117 #===================== EXP2 ===================== 118 118 export DATE1_2 DATE2_2 … … 127 127 export VAR2_Ithick V2It_PREF V2It_SUFF 128 128 export VAR2_SNOW V2SNOW_PREF V2SNOW_SUFF 129 export VAR2_IvelV V2IvV_PREF V2IvV_ PREF129 export VAR2_IvelV V2IvV_PREF V2IvV_SUFF 130 130 # -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh_example1
r4394 r5350 112 112 export VAR1_Ithick V1It_PREF V1It_SUFF 113 113 export VAR1_SNOW V1SNOW_PREF V1SNOW_SUFF 114 export VAR1_IvelV V1IvV_PREF V1IvV_ PREF114 export VAR1_IvelV V1IvV_PREF V1IvV_SUFF 115 115 #===================== EXP2 ===================== 116 116 export DATE1_2 DATE2_2 … … 125 125 export VAR2_Ithick V2It_PREF V2It_SUFF 126 126 export VAR2_SNOW V2SNOW_PREF V2SNOW_SUFF 127 export VAR2_IvelV V2IvV_PREF V2IvV_ PREF127 export VAR2_IvelV V2IvV_PREF V2IvV_SUFF 128 128 # -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/CONFIG/ORCA2_LIM/IDL_scripts/std_ts_vardef.sh_example2
r4394 r5350 112 112 export VAR1_Ithick V1It_PREF V1It_SUFF 113 113 export VAR1_SNOW V1SNOW_PREF V1SNOW_SUFF 114 export VAR1_IvelV V1IvV_PREF V1IvV_ PREF114 export VAR1_IvelV V1IvV_PREF V1IvV_SUFF 115 115 #===================== EXP2 ===================== 116 116 export DATE1_2 DATE2_2 … … 125 125 export VAR2_Ithick V2It_PREF V2It_SUFF 126 126 export VAR2_SNOW V2SNOW_PREF V2SNOW_SUFF 127 export VAR2_IvelV V2IvV_PREF V2IvV_ PREF127 export VAR2_IvelV V2IvV_PREF V2IvV_SUFF 128 128 # -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/CONFIG/SHARED/domain_def.xml
r4690 r5350 6 6 <domain id="myzoom" zoom_ibegin="10" zoom_jbegin="10" zoom_ni="5" zoom_nj="5" /> 7 7 <domain id="1point" zoom_ibegin="10" zoom_jbegin="10" zoom_ni="1" zoom_nj="1" /> 8 <domain id="ptr" zoom_ibegin="0000" zoom_jbegin="1" zoom_ni="1" zoom_nj="0000" /> 8 9 <!-- Eq section --> 9 10 <domain id="EqT" zoom_ibegin="1" zoom_jbegin="0000" zoom_ni="0000" zoom_nj="1" /> -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/CONFIG/SHARED/field_def.xml
r5342 r5350 562 562 <field id="berg_real_calving" long_name="icb calving into iceberg class" unit="kg/s" axis_ref="icbcla" /> 563 563 <field id="berg_stored_ice" long_name="icb accumulated ice mass by class" unit="kg" axis_ref="icbcla" /> 564 </field_group> 565 566 <!-- Poleward transport : ptr --> 567 <field_group id="diaptr" domain_ref="ptr" > 568 <field id="zomsfglo" long_name="Meridional Stream-Function: Global" unit="Sv" grid_ref="grid_W_3D" /> 569 <field id="zomsfatl" long_name="Meridional Stream-Function: Atlantic" unit="Sv" grid_ref="grid_W_3D" /> 570 <field id="zomsfpac" long_name="Meridional Stream-Function: Pacific" unit="Sv" grid_ref="grid_W_3D" /> 571 <field id="zomsfind" long_name="Meridional Stream-Function: Indian" unit="Sv" grid_ref="grid_W_3D" /> 572 <field id="zomsfipc" long_name="Meridional Stream-Function: Pacific+Indian" unit="Sv" grid_ref="grid_W_3D" /> 573 <field id="zotemglo" long_name="Zonal Mean Temperature : Global" unit="degC" grid_ref="grid_T_3D" /> 574 <field id="zotematl" long_name="Zonal Mean Temperature : Atlantic" unit="degC" grid_ref="grid_T_3D" /> 575 <field id="zotempac" long_name="Zonal Mean Temperature : Pacific" unit="degC" grid_ref="grid_T_3D" /> 576 <field id="zotemind" long_name="Zonal Mean Temperature : Indian" unit="degC" grid_ref="grid_T_3D" /> 577 <field id="zotemipc" long_name="Zonal Mean Temperature : Pacific+Indian" unit="degC" grid_ref="grid_T_3D" /> 578 <field id="zosalglo" long_name="Zonal Mean Salinity : Global" unit="1e-3" grid_ref="grid_T_3D" /> 579 <field id="zosalatl" long_name="Zonal Mean Salinity : Atlantic" unit="1e-3" grid_ref="grid_T_3D" /> 580 <field id="zosalpac" long_name="Zonal Mean Salinity : Pacific" unit="1e-3" grid_ref="grid_T_3D" /> 581 <field id="zosalind" long_name="Zonal Mean Salinity : Indian" unit="1e-3" grid_ref="grid_T_3D" /> 582 <field id="zosalipc" long_name="Zonal Mean Salinity : Pacific+Indian" unit="1e-3" grid_ref="grid_T_3D" /> 583 <field id="zosrfglo" long_name="Zonal Mean Surface" unit="m2" grid_ref="grid_T_3D" /> 584 <field id="zosrfatl" long_name="Zonal Mean Surface : Atlantic" unit="m2" grid_ref="grid_T_3D" /> 585 <field id="zosrfpac" long_name="Zonal Mean Surface : Pacific" unit="m2" grid_ref="grid_T_3D" /> 586 <field id="zosrfind" long_name="Zonal Mean Surface : Indian" unit="m2" grid_ref="grid_T_3D" /> 587 <field id="zosrfipc" long_name="Zonal Mean Surface : Pacific+Indian" unit="m2" grid_ref="grid_T_3D" /> 588 <field id="sophtadv" long_name="Advective Heat Transport" unit="PW" grid_ref="grid_T_2D" /> 589 <field id="sophtldf" long_name="Diffusive Heat Transport" unit="PW" grid_ref="grid_T_2D" /> 590 <field id="sopstadv" long_name="Advective Salt Transport" unit="Giga g/s" grid_ref="grid_T_2D" /> 591 <field id="sopstldf" long_name="Diffusive Salt Transport" unit="Giga g/s" grid_ref="grid_T_2D" /> 564 592 </field_group> 565 593 -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/CONFIG/SHARED/namelist_ice_lim2_ref
r5124 r5350 14 14 !----------------------------------------------------------------------- 15 15 cn_icerst_in = "restart_ice_in" ! suffix of ice restart name (input) 16 cn_icerst_indir = "." ! directory from which to read input ice restarts 16 17 cn_icerst_out = "restart_ice" ! suffix of ice restart name (output) 18 cn_icerst_outdir = "." ! directory in which to write output ice restarts 17 19 ln_limdyn = .true. ! ice dynamics (T) or thermodynamics only (F) 18 20 ln_limdmp = .false. ! restoring ice thickness and fraction leads (T => fill namice_dmp) -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/CONFIG/SHARED/namelist_ice_lim3_ref
r5129 r5350 17 17 nlay_s = 1 ! number of snow layers (only 1 is working) 18 18 cn_icerst_in = "restart_ice" ! suffix of ice restart name (input) 19 cn_icerst_indir = "." ! directory from which to read input ice restarts 19 20 cn_icerst_out = "restart_ice" ! suffix of ice restart name (output) 21 cn_icerst_outdir = "." ! directory in which to write output ice restarts 20 22 ln_limdyn = .true. ! ice dynamics (T) or thermodynamics only (F) 21 23 rn_amax = 0.999 ! maximum tolerated ice concentration … … 45 47 &namiceitd ! Ice discretization 46 48 !------------------------------------------------------------------------------ 47 nn_catbnd = 1! computation of ice category boundaries based on49 nn_catbnd = 2 ! computation of ice category boundaries based on 48 50 ! 1: tanh function 49 51 ! 2: h^(-alpha), function of rn_himean 50 rn_himean = 2. 5! expected domain-average ice thickness (m), nn_catbnd = 2 only52 rn_himean = 2.0 ! expected domain-average ice thickness (m), nn_catbnd = 2 only 51 53 / 52 54 !------------------------------------------------------------------------------ … … 94 96 ! 3: activate G(he) only --- temporary option 95 97 ! 4: activate lateral melting only --- temporary option 98 ln_it_qnsice = .true. ! iterate the surface non-solar flux with surface temperature (T) or not (F) 96 99 / 97 100 !------------------------------------------------------------------------------ -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/CONFIG/SHARED/namelist_pisces_ref
r4529 r5350 48 48 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 49 49 concnno3 = 1.e-6 ! Nitrate half saturation of nanophytoplankton 50 concdno3 = 3.E-6 ! Phosphate half saturation for diatoms50 concdno3 = 3.E-6 ! Nitrate half saturation for diatoms 51 51 concnnh4 = 1.E-7 ! NH4 half saturation for phyto 52 52 concdnh4 = 3.E-7 ! NH4 half saturation for diatoms 53 53 concnfer = 1.E-9 ! Iron half saturation for phyto 54 54 concdfer = 3.E-9 ! Iron half saturation for diatoms 55 concbfe = 1.E-11 ! Half-saturation for Fe limitation of Bacteria56 concbnh4 = 2.E-8 ! NH4 half saturation for phyto57 concbno3 = 2.E-7 ! Phosphate half saturation for diatoms55 concbfe = 1.E-11 ! Iron half-saturation for DOC remin. 56 concbnh4 = 2.E-8 ! NH4 half saturation for DOC remin. 57 concbno3 = 2.E-7 ! Nitrate half saturation for DOC remin. 58 58 xsizedia = 1.E-6 ! Minimum size criteria for diatoms 59 59 xsizephy = 1.E-6 ! Minimum size criteria for phyto … … 61 61 xsizerd = 3.0 ! Size ratio for diatoms 62 62 xksi1 = 2.E-6 ! half saturation constant for Si uptake 63 xksi2 = 20E-6 ! half saturation constant for Si/C63 xksi2 = 20E-6 ! half saturation constant for Si/C 64 64 xkdoc = 417.E-6 ! half-saturation constant of DOC remineralization 65 65 qnfelim = 7.E-6 ! Optimal quota of phyto … … 86 86 excret2 = 0.05 ! excretion ratio of diatoms 87 87 ln_newprod = .true. ! Enable new parame. of production (T/F) 88 bresp = 0.0 0333! Basal respiration rate89 chlcnm = 0.033 ! M inimum Chl/C in nanophytoplankton90 chlcdm = 0.05 ! M inimum Chl/C in diatoms91 chlcmin = 0.004 ! M aximum Chl/c in phytoplankton88 bresp = 0.033 ! Basal respiration rate 89 chlcnm = 0.033 ! Maximum Chl/C in nanophytoplankton 90 chlcdm = 0.05 ! Maximum Chl/C in diatoms 91 chlcmin = 0.004 ! Minimum Chl/c in phytoplankton 92 92 fecnm = 40E-6 ! Maximum Fe/C in nanophytoplankton 93 fecdm = 40E-6 ! M inimum Fe/C in diatoms93 fecdm = 40E-6 ! Maximum Fe/C in diatoms 94 94 grosip = 0.159 ! mean Si/C ratio 95 95 / … … 110 110 resrat2 = 0.005 ! exsudation rate of mesozooplankton 111 111 mzrat2 = 0.03 ! mesozooplankton mortality rate 112 xprefc = 1. ! zoo preference for phyto113 xprefp = 0.3 ! zoo preference for POC114 xprefz = 1. ! zoo preference for zoo115 xprefpoc = 0.3 ! zoo preference for poc112 xprefc = 1. ! mesozoo preference for diatoms 113 xprefp = 0.3 ! mesozoo preference for nanophyto. 114 xprefz = 1. ! mesozoo preference for microzoo. 115 xprefpoc = 0.3 ! mesozoo preference for poc 116 116 xthresh2zoo = 1E-8 ! zoo feeding threshold for mesozooplankton 117 117 xthresh2dia = 1E-8 ! diatoms feeding threshold for mesozooplankton … … 119 119 xthresh2poc = 1E-8 ! poc feeding threshold for mesozooplankton 120 120 xthresh2 = 3E-7 ! Food threshold for grazing 121 xkgraz2 = 20.E-6 ! half s turation constant for meso grazing121 xkgraz2 = 20.E-6 ! half saturation constant for meso grazing 122 122 epsher2 = 0.35 ! Efficicency of Mesozoo growth 123 123 sigma2 = 0.6 ! Fraction of mesozoo excretion as DOM … … 156 156 &nampisrem ! parameters for remineralization 157 157 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 158 xremik = 0.3 5! remineralization rate of DOC158 xremik = 0.3 ! remineralization rate of DOC 159 159 xremip = 0.025 ! remineralisation rate of POC 160 160 nitrif = 0.05 ! NH4 nitrification rate -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/CONFIG/SHARED/namelist_ref
r5342 r5350 10 10 !! 7 - dynamics (namdyn_adv, namdyn_vor, namdyn_hpg, namdyn_spg, namdyn_ldf) 11 11 !! 8 - Verical physics (namzdf, namzdf_ric, namzdf_tke, namzdf_kpp, namzdf_ddm, namzdf_tmx) 12 !! 9 - diagnostics (namnc4, namtrd, namspr, namflo, nam ptr, namhsb)12 !! 9 - diagnostics (namnc4, namtrd, namspr, namflo, namhsb, namsto) 13 13 !! 10 - miscellaneous (namsol, nammpp, namctl) 14 14 !! 11 - Obs & Assim (namobs, nam_asminc) … … 37 37 ! = 2 nn_date0 read in restart ; nn_it000 : check consistancy between namelist and restart 38 38 cn_ocerst_in = "restart" ! suffix of ocean restart name (input) 39 cn_ocerst_indir = "." ! directory from which to read input ocean restarts 39 40 cn_ocerst_out = "restart" ! suffix of ocean restart name (output) 41 cn_ocerst_outdir = "." ! directory in which to write output ocean restarts 40 42 nn_istate = 0 ! output the initial state (1) or not (0) 43 ln_rst_list = .false. ! output restarts at list of times using nn_stocklist (T) or at set frequency with nn_stock (F) 41 44 nn_stock = 5475 ! frequency of creation of a restart file (modulo referenced to 1) 45 nn_stocklist = 0,0,0,0,0,0,0,0,0,0 ! List of timesteps when a restart file is to be written 42 46 nn_write = 5475 ! frequency of write in the output file (modulo referenced to nn_it000) 43 47 ln_dimgnnn = .false. ! DIMG file format: 1 file for all processors (F) or by processor (T) … … 51 55 !! *** Domain namelists *** 52 56 !!====================================================================== 53 !! namcfg parameters of the configuration 57 !! namcfg parameters of the configuration 54 58 !! namzgr vertical coordinate 55 59 !! namzgr_sco s-coordinate or hybrid z-s-coordinate … … 59 63 ! 60 64 !----------------------------------------------------------------------- 61 &namcfg ! parameters of the configuration 65 &namcfg ! parameters of the configuration 62 66 !----------------------------------------------------------------------- 63 67 cp_cfg = "default" ! name of the configuration … … 73 77 jperio = 0 ! lateral cond. type (between 0 and 6) 74 78 ! = 0 closed ; = 1 cyclic East-West 75 ! = 2 equatorial symmetric ; = 3 North fold T-point pivot 79 ! = 2 equatorial symmetric ; = 3 North fold T-point pivot 76 80 ! = 4 cyclic East-West AND North fold T-point pivot 77 81 ! = 5 North fold F-point pivot 78 82 ! = 6 cyclic East-West AND North fold F-point pivot 79 ln_use_jattr = .false. ! use (T) the file attribute: open_ocean_jstart, if present 83 ln_use_jattr = .false. ! use (T) the file attribute: open_ocean_jstart, if present 80 84 ! in netcdf input files, as the start j-row for reading 81 85 / … … 102 106 !!!!!!! SH94 stretching coefficients (ln_s_sh94 = .true.) 103 107 rn_theta = 6.0 ! surface control parameter (0<=theta<=20) 104 rn_bb = 0.8 ! stretching with SH94 s-sigma 108 rn_bb = 0.8 ! stretching with SH94 s-sigma 105 109 !!!!!!! SF12 stretching coefficient (ln_s_sf12 = .true.) 106 110 rn_alpha = 4.4 ! stretching with SF12 s-sigma … … 111 115 rn_zb_b = -0.2 ! offset for calculating Zb 112 116 !!!!!!!! Other stretching (not SH94 or SF12) [also uses rn_theta above] 113 rn_thetb = 1.0 ! bottom control parameter (0<=thetb<= 1) 117 rn_thetb = 1.0 ! bottom control parameter (0<=thetb<= 1) 114 118 / 115 119 !----------------------------------------------------------------------- … … 119 123 rn_bathy = 0. ! value of the bathymetry. if (=0) bottom flat at jpkm1 120 124 nn_closea = 0 ! remove (=0) or keep (=1) closed seas and lakes (ORCA) 121 nn_msh = 0! create (=1) a mesh file or not (=0)125 nn_msh = 1 ! create (=1) a mesh file or not (=0) 122 126 rn_hmin = -3. ! min depth of the ocean (>0) or min number of ocean level (<0) 123 127 rn_e3zps_min= 20. ! partial step thickness is set larger than the minimum of … … 165 169 nn_baro = 30 ! Number of iterations of barotropic mode 166 170 ! during rn_rdt seconds. Only used if ln_bt_nn_auto=F 167 rn_bt_cmax = 0.8 ! Maximum courant number allowed if ln_bt_nn_auto=T 171 rn_bt_cmax = 0.8 ! Maximum courant number allowed if ln_bt_nn_auto=T 168 172 nn_bt_flt = 1 ! Time filter choice 169 173 ! = 0 None 170 174 ! = 1 Boxcar over nn_baro barotropic steps 171 ! = 2 Boxcar over 2*nn_baro " " 175 ! = 2 Boxcar over 2*nn_baro " " 172 176 / 173 177 !----------------------------------------------------------------------- … … 246 250 ln_rnf = .true. ! runoffs (T => fill namsbc_rnf) 247 251 nn_isf = 0 ! ice shelf melting/freezing (/=0 => fill namsbc_isf) 248 ! 0 =no isf 1 = presence of ISF 249 ! 2 = bg03 parametrisation 3 = rnf file for isf 252 ! 0 =no isf 1 = presence of ISF 253 ! 2 = bg03 parametrisation 3 = rnf file for isf 250 254 ! 4 = ISF fwf specified 251 255 ! option 1 and 4 need ln_isfcav = .true. (domzgr) … … 278 282 &namsbc_flx ! surface boundary condition : flux formulation 279 283 !----------------------------------------------------------------------- 280 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 284 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 281 285 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename ! 282 286 sn_utau = 'utau' , 24 , 'utau' , .false. , .false., 'yearly' , '' , '' , '' … … 321 325 ln_taudif = .false. ! HF tau contribution: use "mean of stress module - module of the mean stress" data 322 326 rn_zqt = 10. ! Air temperature and humidity reference height (m) 323 rn_zu = 10. ! Wind vector reference height (m) 327 rn_zu = 10. ! Wind vector reference height (m) 324 328 rn_pfac = 1. ! multiplicative factor for precipitation (total & snow) 325 329 rn_efac = 1. ! multiplicative factor for evaporation (0. or 1.) 326 rn_vfac = 0. ! multiplicative factor for ocean/ice velocity 330 rn_vfac = 0. ! multiplicative factor for ocean/ice velocity 327 331 ! in the calculation of the wind stress (0.=absolute winds or 1.=relative winds) 328 332 / … … 374 378 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 375 379 ! ! ! (if <0 months) ! name ! (logical) ! (T/F) ! 'monthly' ! filename ! pairing ! filename ! 376 sn_usp = 'sas_grid_U' , 120 , 'vozocrtx' , .true. , .true. , 'yearly' , '' , '' , '' 380 sn_usp = 'sas_grid_U' , 120 , 'vozocrtx' , .true. , .true. , 'yearly' , '' , '' , '' 377 381 sn_vsp = 'sas_grid_V' , 120 , 'vomecrty' , .true. , .true. , 'yearly' , '' , '' , '' 378 382 sn_tem = 'sas_grid_T' , 120 , 'sosstsst' , .true. , .true. , 'yearly' , '' , '' , '' … … 423 427 / 424 428 !----------------------------------------------------------------------- 425 &namsbc_isf ! Top boundary layer (ISF) 429 &namsbc_isf ! Top boundary layer (ISF) 426 430 !----------------------------------------------------------------------- 427 431 ! ! file name ! frequency (hours) ! variable ! time interpol. ! clim ! 'yearly'/ ! weights ! rotation ! … … 500 504 ! Initial mass required for an iceberg of each class 501 505 rn_initial_mass = 8.8e7, 4.1e8, 3.3e9, 1.8e10, 3.8e10, 7.5e10, 1.2e11, 2.2e11, 3.9e11, 7.4e11 502 ! Proportion of calving mass to apportion to each class 506 ! Proportion of calving mass to apportion to each class 503 507 rn_distribution = 0.24, 0.12, 0.15, 0.18, 0.12, 0.07, 0.03, 0.03, 0.03, 0.02 504 508 ! Ratio between effective and real iceberg mass (non-dim) 505 ! i.e. number of icebergs represented at a point 509 ! i.e. number of icebergs represented at a point 506 510 rn_mass_scaling = 2000, 200, 50, 20, 10, 5, 2, 1, 1, 1 507 511 ! thickness of newly calved bergs (m) … … 512 516 rn_bits_erosion_fraction = 0. ! Fraction of erosion melt flux to divert to bergy bits 513 517 rn_sicn_shift = 0. ! Shift of sea-ice concn in erosion flux (0<sicn_shift<1) 514 ln_passive_mode = .false. ! iceberg - ocean decoupling 518 ln_passive_mode = .false. ! iceberg - ocean decoupling 515 519 nn_test_icebergs = 10 ! Create test icebergs of this class (-1 = no) 516 520 ! Put a test iceberg at each gridpoint in box (lon1,lon2,lat1,lat2) 517 521 rn_test_box = 108.0, 116.0, -66.0, -58.0 518 rn_speed_limit = 0. ! CFL speed limit for a berg 522 rn_speed_limit = 0. ! CFL speed limit for a berg 519 523 520 524 ! ! file name ! frequency (hours) ! variable ! time interp. ! clim ! 'yearly'/ ! weights ! rotation ! land/sea mask ! 521 525 ! ! ! (if <0 months) ! name ! (logical) ! (T/F ) ! 'monthly' ! filename ! pairing ! filename ! 522 526 sn_icb = 'calving' , -1 , 'calvingmask', .true. , .true. , 'yearly' , '' , '' , '' 523 524 cn_dir = './' 527 528 cn_dir = './' 525 529 / 526 530 … … 583 587 ln_tide_ramp = .false. ! 584 588 rdttideramp = 0. ! 585 clname(1) = 'M2' ! name of constituent 586 clname(2) = 'S2' 587 clname(3) = 'N2' 588 clname(4) = 'K1' 589 clname(5) = 'O1' 590 clname(6) = 'Q1' 591 clname(7) = 'M4' 592 clname(8) = 'K2' 593 clname(9) = 'P1' 594 clname(10) = 'Mf' 595 clname(11) = 'Mm' 589 clname(1) = 'DUMMY' ! name of constituent - all tidal components must be set in namelist_cfg 596 590 / 597 591 !----------------------------------------------------------------------- … … 608 602 ! = 2, use tidal harmonic forcing data from files 609 603 ! = 3, use external data AND tidal harmonic forcing 610 cn_dyn3d = 'none' ! 604 cn_dyn3d = 'none' ! 611 605 nn_dyn3d_dta = 0 ! = 0, bdy data are equal to the initial state 612 606 ! = 1, bdy data are read in 'bdydata .nc' files 613 cn_tra = 'none' ! 607 cn_tra = 'none' ! 614 608 nn_tra_dta = 0 ! = 0, bdy data are equal to the initial state 615 609 ! = 1, bdy data are read in 'bdydata .nc' files 616 cn_ice_lim = 'none' ! 610 cn_ice_lim = 'none' ! 617 611 nn_ice_lim_dta = 0 ! = 0, bdy data are equal to the initial state 618 612 ! = 1, bdy data are read in 'bdydata .nc' files … … 623 617 ln_tra_dmp =.false. ! open boudaries conditions for tracers 624 618 ln_dyn3d_dmp =.false. ! open boundary condition for baroclinic velocities 625 rn_time_dmp = 1. ! Damping time scale in days 619 rn_time_dmp = 1. ! Damping time scale in days 626 620 rn_time_dmp_out = 1. ! Outflow damping time scale 627 621 nn_rimwidth = 10 ! width of the relaxation zone … … 676 670 rn_bfri2_max = 1.e-1 ! max. bottom drag coefficient (non linear case and ln_loglayer=T) 677 671 rn_bfeb2 = 2.5e-3 ! bottom turbulent kinetic energy background (m2/s2) 678 rn_bfrz0 = 3.e-3 ! bottom roughness [m] if ln_loglayer=T 672 rn_bfrz0 = 3.e-3 ! bottom roughness [m] if ln_loglayer=T 679 673 ln_bfr2d = .false. ! horizontal variation of the bottom friction coef (read a 2D mask file ) 680 674 rn_bfrien = 50. ! local multiplying factor of bfr (ln_bfr2d=T) … … 722 716 !----------------------------------------------------------------------- 723 717 nn_eos = -1 ! type of equation of state and Brunt-Vaisala frequency 724 ! =-1, TEOS-10 725 ! = 0, EOS-80 718 ! =-1, TEOS-10 719 ! = 0, EOS-80 726 720 ! = 1, S-EOS (simplified eos) 727 721 ln_useCT = .true. ! use of Conservative Temp. ==> surface CT converted in Pot. Temp. in sbcssm … … 814 808 !----------------------------------------------------------------------- 815 809 ln_dynadv_vec = .true. ! vector form (T) or flux form (F) 810 nn_dynkeg = 0 ! scheme for grad(KE): =0 C2 ; =1 Hollingsworth correction 816 811 ln_dynadv_cen2= .false. ! flux form - 2nd order centered scheme 817 812 ln_dynadv_ubs = .false. ! flux form - 3rd order UBS scheme … … 821 816 &nam_vvl ! vertical coordinate options 822 817 !----------------------------------------------------------------------- 823 ln_vvl_zstar = .true. ! zstar vertical coordinate 818 ln_vvl_zstar = .true. ! zstar vertical coordinate 824 819 ln_vvl_ztilde = .false. ! ztilde vertical coordinate: only high frequency variations 825 820 ln_vvl_layer = .false. ! full layer vertical coordinate … … 1006 1001 !! namc1d_uvd data: U & V currents ("key_c1d") 1007 1002 !! namc1d_dyndmp U & V newtonian damping ("key_c1d") 1003 !! namsto Stochastic parametrization of EOS 1008 1004 !!====================================================================== 1009 1005 ! … … 1064 1060 ln_dyndmp = .false. ! add a damping term (T) or not (F) 1065 1061 / 1062 !----------------------------------------------------------------------- 1063 &namsto ! Stochastic parametrization of EOS 1064 !----------------------------------------------------------------------- 1065 ln_rststo = .false. ! start from mean parameter (F) or from restart file (T) 1066 ln_rstseed = .true. ! read seed of RNG from restart file 1067 cn_storst_in = "restart_sto" ! suffix of stochastic parameter restart file (input) 1068 cn_storst_out = "restart_sto" ! suffix of stochastic parameter restart file (output) 1069 1070 ln_sto_eos = .false. ! stochastic equation of state 1071 nn_sto_eos = 1 ! number of independent random walks 1072 rn_eos_stdxy = 1.4 ! random walk horz. standard deviation (in grid points) 1073 rn_eos_stdz = 0.7 ! random walk vert. standard deviation (in grid points) 1074 rn_eos_tcor = 1440.0 ! random walk time correlation (in timesteps) 1075 nn_eos_ord = 1 ! order of autoregressive processes 1076 nn_eos_flt = 0 ! passes of Laplacian filter 1077 rn_eos_lim = 2.0 ! limitation factor (default = 3.0) 1078 / 1066 1079 1067 1080 !!====================================================================== … … 1070 1083 !! namnc4 netcdf4 chunking and compression settings ("key_netcdf4") 1071 1084 !! namtrd dynamics and/or tracer trends 1085 !! namptr Poleward Transport Diagnostics 1072 1086 !! namflo float parameters ("key_float") 1073 !! namptr Poleward Transport Diagnostics1074 1087 !! namhsb Heat and salt budgets 1075 1088 !!====================================================================== … … 1125 1138 !----------------------------------------------------------------------- 1126 1139 ln_diaptr = .false. ! Poleward heat and salt transport (T) or not (F) 1127 ln_diaznl = .true. ! Add zonal means and meridional stream functions 1128 ln_subbas = .true. ! Atlantic/Pacific/Indian basins computation (T) or not 1129 ! (orca configuration only, need input basins mask file named "subbasins.nc" 1130 ln_ptrcomp = .true. ! Add decomposition : overturning 1131 nn_fptr = 1 ! Frequency of ptr computation [time step] 1132 nn_fwri = 15 ! Frequency of ptr outputs [time step] 1140 ln_subbas = .false. ! Atlantic/Pacific/Indian basins computation (T) or not 1133 1141 / 1134 1142 !----------------------------------------------------------------------- … … 1180 1188 ln_sst = .false. ! Logical switch for SST observations 1181 1189 ln_reysst = .false. ! ln_reysst Logical switch for Reynolds observations 1182 ln_ghrsst = .false. ! ln_ghrsst Logical switch for GHRSST observations 1190 ln_ghrsst = .false. ! ln_ghrsst Logical switch for GHRSST observations 1183 1191 1184 1192 ln_sstfb = .false. ! Logical switch for feedback SST data … … 1207 1215 sstfbfiles = 'sst_01.nc' 1208 1216 ! seaicefiles Sea Ice input observation file names 1209 seaicefiles = 'seaice_01.nc' 1217 seaicefiles = 'seaice_01.nc' 1210 1218 ! velavcurfiles Vel. cur. daily av. input file name 1211 1219 ! velhvcurfiles Vel. cur. high freq. input file name -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/CONFIG/SHARED/namelist_top_ref
r5102 r5350 21 21 ! = 2 calendar parameters read in the restart file 22 22 cn_trcrst_in = "restart_trc" ! suffix of pass. sn_tracer restart name (input) 23 cn_trcrst_indir = "." ! directory from which to read input passive tracer restarts 23 24 cn_trcrst_out = "restart_trc" ! suffix of pass. sn_tracer restart name (output) 25 cn_trcrst_outdir = "." ! directory to which to write output passive tracer restarts 24 26 / 25 27 !----------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/CONFIG/cfg.txt
r5102 r5350 8 8 ORCA2_LIM_PISCES OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC 9 9 ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC 10 ISOMIP OPA_SRC11 10 GYRE OPA_SRC 12 11 ORCA2_LIM3 OPA_SRC LIM_SRC_3 NST_SRC -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/CONFIG/makenemo
r5092 r5350 200 200 ;; 201 201 add_key) 202 # Checking void argument 203 [ ! -z $2] && { list_add_key=$2; export ${list_add_key}; }202 # Checking if argument has anything other than whitespace 203 [[ ! "$2" =~ ^\ +$ ]] && { list_add_key=$2; export ${list_add_key}; } 204 204 shift 205 205 ;; 206 206 del_key) 207 # Checking void argument 208 [ ! -z $2] && { list_del_key=$2; export ${list_del_key}; }207 # Checking if argument has anything other than whitespace 208 [[ ! "$2" =~ ^\ +$ ]] && { list_del_key=$2; export ${list_del_key}; } 209 209 shift 210 210 ;; … … 317 317 318 318 #- At this stage new configuration has been added, we add or remove keys 319 [ ! -z ${list_add_key}] && { . ${COMPIL_DIR}/Fadd_keys.sh ${NEW_CONF} add_key ${list_add_key}; }320 [ ! -z ${list_del_key}] && { . ${COMPIL_DIR}/Fdel_keys.sh ${NEW_CONF} del_key ${list_del_key}; }319 [ ! -z "${list_add_key}" ] && { . ${COMPIL_DIR}/Fadd_keys.sh ${NEW_CONF} add_key ${list_add_key}; } 320 [ ! -z "${list_del_key}" ] && { . ${COMPIL_DIR}/Fdel_keys.sh ${NEW_CONF} del_key ${list_del_key}; } 321 321 322 322 #- check that all keys are really existing... -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/CONFIG/uspcfg.txt
r4990 r5350 1 1 ORCA1_CICE # ORCA2_LIM # OPA_SRC TOP_SRC # http://gws-access.ceda.ac.uk/public/nemo/uspconfigs/ORCA1_CICE/v3.6.0/ORCA1_CICE_ctl.txt 2 ISOMIP # GYRE # OPA_SRC # http://gws-access.ceda.ac.uk/public/nemo/uspconfigs/ISOMIP/v3.6.0/ISOMIP_ctl.txt -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_2/ice_2.F90
r5123 r5350 24 24 ! !!* namicerun read in iceini * 25 25 CHARACTER(len=32) , PUBLIC :: cn_icerst_in !: suffix of ice restart name (input) 26 CHARACTER(len=256) , PUBLIC :: cn_icerst_indir !: ice restart in directory 26 27 CHARACTER(len=32) , PUBLIC :: cn_icerst_out !: suffix of ice restart name (output) 28 CHARACTER(len=256) , PUBLIC :: cn_icerst_outdir !: ice restart out directory 27 29 LOGICAL , PUBLIC :: ln_limdyn !: flag for ice dynamics (T) or not (F) 28 30 LOGICAL , PUBLIC :: ln_limdmp !: Ice damping -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_2/iceini_2.F90
r4624 r5350 40 40 !!---------------------------------------------------------------------- 41 41 !! NEMO/LIM2 4.0 , UCL - NEMO Consortium (2011) 42 !! $Id$ 42 !! $Id$ 43 43 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 44 44 !!---------------------------------------------------------------------- … … 123 123 !! ** input : Namelist namicerun 124 124 !!------------------------------------------------------------------- 125 NAMELIST/namicerun/ cn_icerst_in, cn_icerst_out, ln_limdyn, ln_limdmp, acrit, hsndif, hicdif 125 NAMELIST/namicerun/ cn_icerst_in, cn_icerst_indir, cn_icerst_out, cn_icerst_outdir, & 126 ln_limdyn, ln_limdmp, acrit, hsndif, hicdif 126 127 INTEGER :: ios ! Local integer output status for namelist read 127 128 !!------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_2/limrhg.F90
- Property svn:keywords set to Id
-
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_2/limrst_2.F90
r2528 r5350 50 50 CHARACTER(LEN=20) :: clkt ! ocean time-step deine as a character 51 51 CHARACTER(LEN=50) :: clname ! ice output restart file name 52 CHARACTER(len=150) :: clpath ! full path to ice output restart file 52 53 !!---------------------------------------------------------------------- 53 54 ! … … 58 59 ! except if we write ice restart files every ice time step or if an ice restart file was writen at nitend - 2*nn_fsbc + 1 59 60 IF( kt == nitrst - 2*nn_fsbc + 1 .OR. nstock == nn_fsbc .OR. ( kt == nitend - nn_fsbc + 1 .AND. .NOT. lrst_ice ) ) THEN 60 ! beware of the format used to write kt (default is i8.8, that should be large enough...) 61 IF( nitrst > 99999999 ) THEN ; WRITE(clkt, * ) nitrst 62 ELSE ; WRITE(clkt, '(i8.8)') nitrst 61 IF( nitrst <= nitend .AND. nitrst > 0 ) THEN 62 ! beware of the format used to write kt (default is i8.8, that should be large enough...) 63 IF( nitrst > 99999999 ) THEN ; WRITE(clkt, * ) nitrst 64 ELSE ; WRITE(clkt, '(i8.8)') nitrst 65 ENDIF 66 ! create the file 67 clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_icerst_out) 68 clpath = TRIM(cn_icerst_outdir) 69 IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath)//'/' 70 IF(lwp) THEN 71 WRITE(numout,*) 72 SELECT CASE ( jprstlib ) 73 CASE ( jprstdimg ) 74 WRITE(numout,*) ' open ice restart binary file: ',TRIM(clpath)//clname 75 CASE DEFAULT 76 WRITE(numout,*) ' open ice restart NetCDF file: ',TRIM(clpath)//clname 77 END SELECT 78 IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN 79 WRITE(numout,*) ' kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp 80 ELSE ; WRITE(numout,*) ' kt = ' , kt,' date= ', ndastp 81 ENDIF 82 ENDIF 83 84 CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kiolib = jprstlib ) 85 lrst_ice = .TRUE. 63 86 ENDIF 64 ! create the file65 clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_icerst_out)66 IF(lwp) THEN67 WRITE(numout,*)68 SELECT CASE ( jprstlib )69 CASE ( jprstdimg ) ; WRITE(numout,*) ' open ice restart binary file: '//clname70 CASE DEFAULT ; WRITE(numout,*) ' open ice restart NetCDF file: '//clname71 END SELECT72 IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN73 WRITE(numout,*) ' kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp74 ELSE ; WRITE(numout,*) ' kt = ' , kt,' date= ', ndastp75 ENDIF76 ENDIF77 78 CALL iom_open( clname, numriw, ldwrt = .TRUE., kiolib = jprstlib )79 lrst_ice = .TRUE.80 87 ENDIF 81 88 ! … … 188 195 ! eventually read netcdf file (monobloc) for restarting on different number of processors 189 196 ! if {cn_icerst_in}.nc exists, then set jlibalt to jpnf90 190 INQUIRE( FILE = TRIM(cn_icerst_in )//'.nc', EXIST = llok )197 INQUIRE( FILE = TRIM(cn_icerst_indir)//'/'//TRIM(cn_icerst_in)//'.nc', EXIST = llok ) 191 198 IF ( llok ) THEN ; jlibalt = jpnf90 ; ELSE ; jlibalt = jprstlib ; ENDIF 192 199 ENDIF 193 200 194 CALL iom_open ( cn_icerst_in, numrir, kiolib = jlibalt )201 CALL iom_open ( TRIM(cn_icerst_indir)//'/'//TRIM(cn_icerst_in), numrir, kiolib = jlibalt ) 195 202 196 203 CALL iom_get( numrir, 'kt_ice' , ziter ) -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/ice.F90
r5128 r5350 198 198 INTEGER , PUBLIC :: nn_ice_thcon !: thermal conductivity: =0 Untersteiner (1964) ; =1 Pringle et al (2007) 199 199 INTEGER , PUBLIC :: nn_monocat !: virtual ITD mono-category parameterizations (1) or not (0) 200 LOGICAL , PUBLIC :: ln_it_qnsice !: iterate surface flux with changing surface temperature or not (F) 200 201 201 202 ! !!** ice-mechanical redistribution namelist (namiceitdme) … … 285 286 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_snw !: heat flux for snow melt 286 287 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_err !: heat flux error after heat diffusion 288 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_err_dif !: heat flux remaining due to change in non-solar flux 287 289 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_err_rem !: heat flux error after heat remapping 288 290 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_in !: heat flux available for thermo transformations … … 371 373 INTEGER , PUBLIC :: nlay_s !: number of snow layers 372 374 CHARACTER(len=32), PUBLIC :: cn_icerst_in !: suffix of ice restart name (input) 375 CHARACTER(len=256), PUBLIC :: cn_icerst_indir !: ice restart input directory 373 376 CHARACTER(len=32), PUBLIC :: cn_icerst_out !: suffix of ice restart name (output) 377 CHARACTER(len=256), PUBLIC :: cn_icerst_outdir!: ice restart output directory 374 378 LOGICAL , PUBLIC :: ln_limdyn !: flag for ice dynamics (T) or not (F) 375 379 LOGICAL , PUBLIC :: ln_icectl !: flag for sea-ice points output (T) or not (F) … … 392 396 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_trp_smv !: transport of salt content 393 397 ! 394 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_heat_dhc !: snw/ice heat content variation [W/m2] 398 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_heat !: snw/ice heat content variation [W/m2] 399 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_smvi !: ice salt content variation [] 400 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_vice !: ice volume variation [m/s] 401 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: diag_vsnw !: snw volume variation [m/s] 395 402 ! 396 403 !!---------------------------------------------------------------------- … … 433 440 & sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) , & 434 441 & sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) , & 435 & hfx_res(jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) , hfx_err(jpi,jpj) , hfx_err_rem(jpi,jpj), & 442 & hfx_res(jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) , hfx_err(jpi,jpj) , & 443 & hfx_err_dif(jpi,jpj) , hfx_err_rem(jpi,jpj) , & 436 444 & hfx_in (jpi,jpj) , hfx_out(jpi,jpj) , fhld(jpi,jpj) , & 437 445 & hfx_sum(jpi,jpj) , hfx_bom(jpi,jpj) , hfx_bog(jpi,jpj) , hfx_dif(jpi,jpj) , hfx_opw(jpi,jpj) , & … … 452 460 ALLOCATE( t_s(jpi,jpj,nlay_s,jpl) , e_s(jpi,jpj,nlay_s,jpl) , STAT=ierr(ii) ) 453 461 ii = ii + 1 454 ALLOCATE( t_i(jpi,jpj,nlay_i +1,jpl) , e_i(jpi,jpj,nlay_i+1,jpl) , s_i(jpi,jpj,nlay_i+1,jpl) , STAT=ierr(ii) )462 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) ) 455 463 456 464 ! * Moments for advection … … 468 476 & STAT=ierr(ii) ) 469 477 ii = ii + 1 470 ALLOCATE( sxe (jpi,jpj,nlay_i +1,jpl) , sye (jpi,jpj,nlay_i+1,jpl) , sxxe(jpi,jpj,nlay_i+1,jpl) , &471 & syye(jpi,jpj,nlay_i +1,jpl) , sxye(jpi,jpj,nlay_i+1,jpl), STAT=ierr(ii) )478 ALLOCATE( sxe (jpi,jpj,nlay_i,jpl) , sye (jpi,jpj,nlay_i,jpl) , sxxe(jpi,jpj,nlay_i,jpl) , & 479 & syye(jpi,jpj,nlay_i,jpl) , sxye(jpi,jpj,nlay_i,jpl) , STAT=ierr(ii) ) 472 480 473 481 ! * Old values of global variables 474 482 ii = ii + 1 475 483 ALLOCATE( v_s_b (jpi,jpj,jpl) , v_i_b (jpi,jpj,jpl) , e_s_b(jpi,jpj,nlay_s,jpl) , & 476 & a_i_b (jpi,jpj,jpl) , smv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i +1 ,jpl) ,&477 & oa_i_b (jpi,jpj,jpl) , u_ice_b(jpi,jpj) , v_ice_b(jpi,jpj) 484 & a_i_b (jpi,jpj,jpl) , smv_i_b(jpi,jpj,jpl) , e_i_b(jpi,jpj,nlay_i,jpl) , & 485 & oa_i_b (jpi,jpj,jpl) , u_ice_b(jpi,jpj) , v_ice_b(jpi,jpj) , STAT=ierr(ii) ) 478 486 479 487 ! * Ice thickness distribution variables … … 483 491 ! * Ice diagnostics 484 492 ii = ii + 1 485 ALLOCATE( diag_trp_vi(jpi,jpj), diag_trp_vs (jpi,jpj), diag_trp_ei (jpi,jpj), & 486 & diag_trp_es(jpi,jpj), diag_trp_smv(jpi,jpj), diag_heat_dhc(jpi,jpj), STAT=ierr(ii) ) 493 ALLOCATE( diag_trp_vi(jpi,jpj), diag_trp_vs (jpi,jpj), diag_trp_ei(jpi,jpj), & 494 & diag_trp_es(jpi,jpj), diag_trp_smv(jpi,jpj), diag_heat (jpi,jpj), & 495 & diag_smvi (jpi,jpj), diag_vice (jpi,jpj), diag_vsnw (jpi,jpj), STAT=ierr(ii) ) 487 496 488 497 ice_alloc = MAXVAL( ierr(:) ) -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90
r5123 r5350 8 8 !! 3.5 ! 2011-02 (G. Madec) add mpp considerations 9 9 !! - ! 2014-05 (C. Rousset) add lim_cons_hsm 10 !! - ! 2015-03 (C. Rousset) add lim_cons_final 10 11 !!---------------------------------------------------------------------- 11 12 #if defined key_lim3 … … 22 23 USE lib_mpp ! MPP library 23 24 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 25 USE sbc_oce , ONLY : sfx ! Surface boundary condition: ocean fields 24 26 25 27 IMPLICIT NONE … … 30 32 PUBLIC lim_cons_check 31 33 PUBLIC lim_cons_hsm 34 PUBLIC lim_cons_final 32 35 33 36 !!---------------------------------------------------------------------- … … 72 75 !! ** Method : Arithmetics 73 76 !!--------------------------------------------------------------------- 74 INTEGER 75 INTEGER 76 REAL(wp), DIMENSION(jpi,jpj,nlay_i +1,jpl), INTENT(in ) :: pin!: input field77 REAL(wp), DIMENSION(jpi,jpj) 77 INTEGER , INTENT(in ) :: ksum !: number of categories 78 INTEGER , INTENT(in ) :: klay !: number of vertical layers 79 REAL(wp), DIMENSION(jpi,jpj,nlay_i,jpl), INTENT(in ) :: pin !: input field 80 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: pout !: output field 78 81 ! 79 82 INTEGER :: jk, jl ! dummy loop indices … … 155 158 156 159 SUBROUTINE lim_cons_hsm( icount, cd_routine, zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b ) 157 !!------------------------------------------------------------------- 158 !! *** ROUTINE lim_cons_hsm *** 159 !! 160 !! ** Purpose : Test the conservation of heat, salt and mass for each routine 161 !! 162 !! ** Method : 163 !!--------------------------------------------------------------------- 164 INTEGER , INTENT(in) :: icount ! determine wether this is the beggining of the routine (0) or the end (1) 165 CHARACTER(len=*), INTENT(in) :: cd_routine ! name of the routine 160 !!-------------------------------------------------------------------------------------------------------- 161 !! *** ROUTINE lim_cons_hsm *** 162 !! 163 !! ** Purpose : Test the conservation of heat, salt and mass for each ice routine 164 !! + test if ice concentration and volume are > 0 165 !! 166 !! ** Method : This is an online diagnostics which can be activated with ln_limdiahsb=true 167 !! It prints in ocean.output if there is a violation of conservation at each time-step 168 !! The thresholds (zv_sill, zs_sill, zh_sill) which determine violations are set to 169 !! a minimum of 1 mm of ice (over the ice area) that is lost/gained spuriously during 100 years. 170 !! For salt and heat thresholds, ice is considered to have a salinity of 10 171 !! and a heat content of 3e5 J/kg (=latent heat of fusion) 172 !!-------------------------------------------------------------------------------------------------------- 173 INTEGER , INTENT(in) :: icount ! determine wether this is the beggining of the routine (0) or the end (1) 174 CHARACTER(len=*), INTENT(in) :: cd_routine ! name of the routine 166 175 REAL(wp) , INTENT(inout) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 167 176 REAL(wp) :: zvi, zsmv, zei, zfs, zfw, zft 168 177 REAL(wp) :: zvmin, zamin, zamax 169 REAL(wp) :: z conv170 171 zconv = 1.e-9178 REAL(wp) :: zvtrp, zetrp 179 REAL(wp) :: zarea, zv_sill, zs_sill, zh_sill 180 REAL(wp), PARAMETER :: zconv = 1.e-9 ! convert W to GW and kg to Mt 172 181 173 182 IF( icount == 0 ) THEN 174 183 184 ! salt flux 175 185 zfs_b = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + & 176 186 & sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) & 177 & ) * e12t(:,:) * tmask(:,:,1) ) 178 187 & ) * e12t(:,:) * tmask(:,:,1) * zconv ) 188 189 ! water flux 179 190 zfw_b = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + & 180 191 & wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:) & 181 & ) * e12t(:,:) * tmask(:,:,1) ) 182 192 & ) * e12t(:,:) * tmask(:,:,1) * zconv ) 193 194 ! heat flux 183 195 zft_b = glob_sum( ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:) & 184 196 & - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:) & 185 197 & ) * e12t(:,:) * tmask(:,:,1) * zconv ) 186 198 187 zvi_b = glob_sum( SUM( v_i (:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) * e12t(:,:) * tmask(:,:,1))188 189 zsmv_b = glob_sum( SUM( smv_i (:,:,:), dim=3 ) * e12t(:,:) * tmask(:,:,1))199 zvi_b = glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 ) * e12t * tmask(:,:,1) * zconv ) 200 201 zsmv_b = glob_sum( SUM( smv_i * rhoic , dim=3 ) * e12t * tmask(:,:,1) * zconv ) 190 202 191 203 zei_b = glob_sum( ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) + & 192 204 & SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 ) & 193 ) * e12t (:,:)* tmask(:,:,1) * zconv )205 ) * e12t * tmask(:,:,1) * zconv ) 194 206 195 207 ELSEIF( icount == 1 ) THEN 196 208 209 ! salt flux 197 210 zfs = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + & 198 211 & sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) & 199 & ) * e12t(:,:) * tmask(:,:,1) ) - zfs_b 200 212 & ) * e12t(:,:) * tmask(:,:,1) * zconv ) - zfs_b 213 214 ! water flux 201 215 zfw = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + & 202 216 & wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:) & 203 & ) * e12t(:,:) * tmask(:,:,1) ) - zfw_b 204 217 & ) * e12t(:,:) * tmask(:,:,1) * zconv ) - zfw_b 218 219 ! heat flux 205 220 zft = glob_sum( ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:) & 206 221 & - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:) & 207 222 & ) * e12t(:,:) * tmask(:,:,1) * zconv ) - zft_b 208 223 209 zvi = ( glob_sum( SUM( v_i(:,:,:)*rhoic + v_s(:,:,:)*rhosn, dim=3 ) & 210 & * e12t(:,:) * tmask(:,:,1) ) - zvi_b ) * r1_rdtice - zfw 211 212 zsmv = ( glob_sum( SUM( smv_i(:,:,:), dim=3 ) * e12t(:,:) * tmask(:,:,1) ) - zsmv_b ) * r1_rdtice + ( zfs * r1_rhoic ) 224 ! outputs 225 zvi = ( ( glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 ) & 226 & * e12t * tmask(:,:,1) * zconv ) - zvi_b ) * r1_rdtice - zfw ) * rday 227 228 zsmv = ( ( glob_sum( SUM( smv_i * rhoic , dim=3 ) & 229 & * e12t * tmask(:,:,1) * zconv ) - zsmv_b ) * r1_rdtice + zfs ) * rday 213 230 214 231 zei = glob_sum( ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) + & 215 232 & SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 ) & 216 & ) * e12t(:,:) * tmask(:,:,1) * zconv ) * r1_rdtice - zei_b * r1_rdtice + zft 233 & ) * e12t * tmask(:,:,1) * zconv ) * r1_rdtice - zei_b * r1_rdtice + zft 234 235 ! zvtrp and zetrp must be close to 0 if the advection scheme is conservative 236 zvtrp = glob_sum( ( diag_trp_vi * rhoic + diag_trp_vs * rhosn ) * e12t * tmask(:,:,1) * zconv ) * rday 237 zetrp = glob_sum( ( diag_trp_ei + diag_trp_es ) * e12t * tmask(:,:,1) * zconv ) 217 238 218 239 zvmin = glob_min( v_i ) 219 240 zamax = glob_max( SUM( a_i, dim=3 ) ) 220 241 zamin = glob_min( a_i ) 221 242 243 ! set threshold values and calculate the ice area (+epsi10 to set a threshold > 0 when there is no ice) 244 zarea = glob_sum( SUM( a_i + epsi10, dim=3 ) * e12t * zconv ) ! in 1.e9 m2 245 zv_sill = zarea * 2.5e-5 246 zs_sill = zarea * 25.e-5 247 zh_sill = zarea * 10.e-5 248 222 249 IF(lwp) THEN 223 IF ( ABS( zvi ) > 1.e-4 ) WRITE(numout,*) 'violation volume [kg/day] (',cd_routine,') = ',(zvi * rday)224 IF ( ABS( zsmv ) > 1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (',cd_routine,') = ',(zsmv * rday)225 IF ( ABS( zei ) > 1.e-4 ) WRITE(numout,*) 'violation enthalpy [GW] (',cd_routine,') = ',(zei)226 IF ( zvmin < -epsi10 ) WRITE(numout,*) 'violation v_i<0 [m] (',cd_routine,') = ',(zvmin)227 IF( cd_routine /= 'limtrp' .AND. cd_routine /= 'limitd_me' .AND. zamax > rn_amax+epsi10 ) THEN228 WRITE(numout,*) 'violation a_i>amax (',cd_routine,') = ',zamax250 IF ( ABS( zvi ) > zv_sill ) WRITE(numout,*) 'violation volume [Mt/day] (',cd_routine,') = ',zvi 251 IF ( ABS( zsmv ) > zs_sill ) WRITE(numout,*) 'violation saline [psu*Mt/day] (',cd_routine,') = ',zsmv 252 IF ( ABS( zei ) > zh_sill ) WRITE(numout,*) 'violation enthalpy [GW] (',cd_routine,') = ',zei 253 IF ( ABS(zvtrp ) > zv_sill .AND. cd_routine == 'limtrp' ) THEN 254 WRITE(numout,*) 'violation vtrp [Mt/day] (',cd_routine,') = ',zvtrp 255 WRITE(numout,*) 'violation etrp [GW] (',cd_routine,') = ',zetrp 229 256 ENDIF 230 IF ( zamin < -epsi10 ) WRITE(numout,*) 'violation a_i<0 (',cd_routine,') = ',zamin 257 IF ( zvmin < -epsi10 ) WRITE(numout,*) 'violation v_i<0 [m] (',cd_routine,') = ',zvmin 258 IF ( zamax > rn_amax+epsi10 .AND. cd_routine /= 'limtrp' .AND. cd_routine /= 'limitd_me' ) THEN 259 WRITE(numout,*) 'violation a_i>amax (',cd_routine,') = ',zamax 260 ENDIF 261 IF ( zamin < -epsi10 ) WRITE(numout,*) 'violation a_i<0 (',cd_routine,') = ',zamin 231 262 ENDIF 232 263 … … 234 265 235 266 END SUBROUTINE lim_cons_hsm 267 268 SUBROUTINE lim_cons_final( cd_routine ) 269 !!--------------------------------------------------------------------------------------------------------- 270 !! *** ROUTINE lim_cons_final *** 271 !! 272 !! ** Purpose : Test the conservation of heat, salt and mass at the end of each ice time-step 273 !! 274 !! ** Method : This is an online diagnostics which can be activated with ln_limdiahsb=true 275 !! It prints in ocean.output if there is a violation of conservation at each time-step 276 !! The thresholds (zv_sill, zs_sill, zh_sill) which determine the violation are set to 277 !! a minimum of 1 mm of ice (over the ice area) that is lost/gained spuriously during 100 years. 278 !! For salt and heat thresholds, ice is considered to have a salinity of 10 279 !! and a heat content of 3e5 J/kg (=latent heat of fusion) 280 !!-------------------------------------------------------------------------------------------------------- 281 CHARACTER(len=*), INTENT(in) :: cd_routine ! name of the routine 282 REAL(wp) :: zhfx, zsfx, zvfx 283 REAL(wp) :: zarea, zv_sill, zs_sill, zh_sill 284 REAL(wp), PARAMETER :: zconv = 1.e-9 ! convert W to GW and kg to Mt 285 286 #if ! defined key_bdy 287 ! heat flux 288 zhfx = glob_sum( ( hfx_in - hfx_out - diag_heat - diag_trp_ei - diag_trp_es - hfx_sub ) * e12t * tmask(:,:,1) * zconv ) 289 ! salt flux 290 zsfx = glob_sum( ( sfx + diag_smvi ) * e12t * tmask(:,:,1) * zconv ) * rday 291 ! water flux 292 zvfx = glob_sum( ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + diag_vice + diag_vsnw ) * e12t * tmask(:,:,1) * zconv ) * rday 293 294 ! set threshold values and calculate the ice area (+epsi10 to set a threshold > 0 when there is no ice) 295 zarea = glob_sum( SUM( a_i + epsi10, dim=3 ) * e12t * zconv ) ! in 1.e9 m2 296 zv_sill = zarea * 2.5e-5 297 zs_sill = zarea * 25.e-5 298 zh_sill = zarea * 10.e-5 299 300 IF( ABS( zvfx ) > zv_sill ) WRITE(numout,*) 'violation vfx [Mt/day] (',cd_routine,') = ',(zvfx) 301 IF( ABS( zsfx ) > zs_sill ) WRITE(numout,*) 'violation sfx [psu*Mt/day] (',cd_routine,') = ',(zsfx) 302 IF( ABS( zhfx ) > zh_sill ) WRITE(numout,*) 'violation hfx [GW] (',cd_routine,') = ',(zhfx) 303 #endif 304 305 END SUBROUTINE lim_cons_final 236 306 237 307 #else -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/limctl.F90
r5125 r5350 419 419 WRITE(numout,*) ' hfx_in : ', hfx_in(ji,jj) 420 420 WRITE(numout,*) ' hfx_out : ', hfx_out(ji,jj) 421 WRITE(numout,*) ' dhc : ', diag_heat _dhc(ji,jj)421 WRITE(numout,*) ' dhc : ', diag_heat(ji,jj) 422 422 WRITE(numout,*) 423 423 WRITE(numout,*) ' hfx_dyn : ', hfx_dyn(ji,jj) -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90
- Property svn:keywords set to Id
r5123 r5350 40 40 !!---------------------------------------------------------------------- 41 41 !! NEMO/OPA 3.4 , NEMO Consortium (2012) 42 !! $Id : limdiahsb.F90 3294 2012-10-18 16:44:18Z rblod$42 !! $Id$ 43 43 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 44 44 !!---------------------------------------------------------------------- … … 115 115 zbg_ihc = glob_sum( et_i(:,:) * e12t(:,:) * 1.e-20 ) ! ice heat content [1.e20 J] 116 116 zbg_shc = glob_sum( et_s(:,:) * e12t(:,:) * 1.e-20 ) ! snow heat content [1.e20 J] 117 zbg_hfx_dhc = glob_sum( diag_heat _dhc(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W]117 zbg_hfx_dhc = glob_sum( diag_heat(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 118 118 zbg_hfx_spr = glob_sum( hfx_spr(:,:) * e12t(:,:) * tmask(:,:,1) ) ! [in W] 119 119 … … 245 245 WRITE(numout,*) '~~~~~~~~~~~~' 246 246 ENDIF 247 248 ! ---------------------------------- !249 ! 2 - initial conservation variables !250 ! ---------------------------------- !251 !frc_vol = 0._wp ! volume trend due to forcing252 !frc_sal = 0._wp ! salt content - - - -253 !bg_grme = 0._wp ! ice growth + melt volume trend254 247 ! 255 248 CALL lim_diahsb_rst( nstart, 'READ' ) !* read or initialize all required files -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90
r5123 r5350 314 314 DO ji = 1, jpi 315 315 a_i(ji,jj,jl) = zswitch(ji,jj) * za_i_ini (jl,zhemis(ji,jj)) ! concentration 316 ht_i(ji,jj,jl) = zswitch(ji,jj) * zh_i_ini(jl,zhemis(ji,jj)) ! ice thickness316 ht_i(ji,jj,jl) = zswitch(ji,jj) * zh_i_ini(jl,zhemis(ji,jj)) ! ice thickness 317 317 ht_s(ji,jj,jl) = ht_i(ji,jj,jl) * ( zht_s_ini( zhemis(ji,jj) ) / zht_i_ini( zhemis(ji,jj) ) ) ! snow depth 318 sm_i(ji,jj,jl) = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) !+ ( 1._wp - zswitch(ji,jj) ) * rn_simin! salinity319 o_i(ji,jj,jl) = zswitch(ji,jj) * 1._wp + ( 1._wp - zswitch(ji,jj) ) ! age318 sm_i(ji,jj,jl) = zswitch(ji,jj) * zsm_i_ini(zhemis(ji,jj)) ! salinity 319 o_i(ji,jj,jl) = zswitch(ji,jj) * 1._wp ! age (1 day) 320 320 t_su(ji,jj,jl) = zswitch(ji,jj) * ztm_i_ini(zhemis(ji,jj)) + ( 1._wp - zswitch(ji,jj) ) * rt0 ! surf temp 321 321 … … 333 333 smv_i(ji,jj,jl) = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) ! salt content 334 334 oa_i(ji,jj,jl) = o_i(ji,jj,jl) * a_i(ji,jj,jl) ! age content 335 END DO ! ji336 END DO ! jj337 END DO ! jl335 END DO 336 END DO 337 END DO 338 338 339 339 ! Snow temperature and heat content … … 348 348 ! Mutliply by volume, and divide by number of layers to get heat content in J/m2 349 349 e_s(ji,jj,jk,jl) = e_s(ji,jj,jk,jl) * v_s(ji,jj,jl) * r1_nlay_s 350 END DO ! ji351 END DO ! jj352 END DO ! jl353 END DO ! jk350 END DO 351 END DO 352 END DO 353 END DO 354 354 355 355 ! Ice salinity, temperature and heat content … … 369 369 ! Mutliply by ice volume, and divide by number of layers to get heat content in J/m2 370 370 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * v_i(ji,jj,jl) * r1_nlay_i 371 END DO ! ji372 END DO ! jj373 END DO ! jl374 END DO ! jk371 END DO 372 END DO 373 END DO 374 END DO 375 375 376 376 tn_ice (:,:,:) = t_su (:,:,:) -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
r5134 r5350 127 127 REAL(wp) :: za, zfac ! local scalar 128 128 CHARACTER (len = 15) :: fieldid 129 REAL(wp), POINTER, DIMENSION(:,:) :: closing_net ! net rate at which area is removed (1/s)130 ! (ridging ice area - area of new ridges) / dt131 REAL(wp), POINTER, DIMENSION(:,:) :: divu_adv ! divu as implied by transport scheme (1/s)132 REAL(wp), POINTER, DIMENSION(:,:) :: opning ! rate of opening due to divergence/shear133 REAL(wp), POINTER, DIMENSION(:,:) :: closing_gross ! rate at which area removed, not counting area of new ridges134 REAL(wp), POINTER, DIMENSION(:,:) :: msnow_mlt ! mass of snow added to ocean (kg m-2)135 REAL(wp), POINTER, DIMENSION(:,:) :: esnow_mlt ! energy needed to melt snow in ocean (J m-2)136 REAL(wp), POINTER, DIMENSION(:,:) :: vt_i_init, vt_i_final ! ice volume summed over categories129 REAL(wp), POINTER, DIMENSION(:,:) :: closing_net ! net rate at which area is removed (1/s) 130 ! (ridging ice area - area of new ridges) / dt 131 REAL(wp), POINTER, DIMENSION(:,:) :: divu_adv ! divu as implied by transport scheme (1/s) 132 REAL(wp), POINTER, DIMENSION(:,:) :: opning ! rate of opening due to divergence/shear 133 REAL(wp), POINTER, DIMENSION(:,:) :: closing_gross ! rate at which area removed, not counting area of new ridges 134 REAL(wp), POINTER, DIMENSION(:,:) :: msnow_mlt ! mass of snow added to ocean (kg m-2) 135 REAL(wp), POINTER, DIMENSION(:,:) :: esnow_mlt ! energy needed to melt snow in ocean (J m-2) 136 REAL(wp), POINTER, DIMENSION(:,:) :: vt_i_init, vt_i_final ! ice volume summed over categories 137 137 ! 138 138 INTEGER, PARAMETER :: nitermax = 20 … … 142 142 IF( nn_timing == 1 ) CALL timing_start('limitd_me') 143 143 144 CALL wrk_alloc( jpi, 144 CALL wrk_alloc( jpi,jpj, closing_net, divu_adv, opning, closing_gross, msnow_mlt, esnow_mlt, vt_i_init, vt_i_final ) 145 145 146 146 IF(ln_ctl) THEN … … 153 153 ! conservation test 154 154 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_me', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 155 156 CALL lim_var_zapsmall 157 CALL lim_var_glo2eqv ! equivalent variables, requested for rafting 155 158 156 159 !-----------------------------------------------------------------------------! … … 235 238 ! Reduce the closing rate if more than 100% of the open water 236 239 ! would be removed. Reduce the opening rate proportionately. 237 IF ( ato_i(ji,jj) > epsi10 .AND. athorn(ji,jj,0) > 0.0 ) THEN 238 za = athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice 239 IF ( za > ato_i(ji,jj)) THEN 240 zfac = ato_i(ji,jj) / za 241 closing_gross(ji,jj) = closing_gross(ji,jj) * zfac 242 opning(ji,jj) = opning(ji,jj) * zfac 243 ENDIF 240 za = athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice 241 IF( za > epsi20 ) THEN 242 zfac = MIN( 1._wp, ato_i(ji,jj) / za ) 243 closing_gross(ji,jj) = closing_gross(ji,jj) * zfac 244 opning (ji,jj) = opning (ji,jj) * zfac 244 245 ENDIF 245 246 … … 251 252 ! Reduce the closing rate if more than 100% of any ice category 252 253 ! would be removed. Reduce the opening rate proportionately. 253 254 254 DO jl = 1, jpl 255 255 DO jj = 1, jpj 256 256 DO ji = 1, jpi 257 IF ( a_i(ji,jj,jl) > epsi10 .AND. athorn(ji,jj,jl) > 0._wp )THEN 258 za = athorn(ji,jj,jl) * closing_gross(ji,jj) * rdt_ice 259 IF ( za > a_i(ji,jj,jl) ) THEN 260 zfac = a_i(ji,jj,jl) / za 261 closing_gross(ji,jj) = closing_gross(ji,jj) * zfac 262 opning (ji,jj) = opning (ji,jj) * zfac 263 ENDIF 257 za = athorn(ji,jj,jl) * closing_gross(ji,jj) * rdt_ice 258 IF( za > epsi20 ) THEN 259 zfac = MIN( 1._wp, a_i(ji,jj,jl) / za ) 260 closing_gross(ji,jj) = closing_gross(ji,jj) * zfac 261 opning (ji,jj) = opning (ji,jj) * zfac 264 262 ENDIF 265 263 END DO … … 368 366 ENDIF 369 367 370 ! updates371 CALL lim_var_glo2eqv372 CALL lim_var_zapsmall373 368 CALL lim_var_agg( 1 ) 374 369 … … 377 372 !-----------------------------------------------------------------------------! 378 373 IF(ln_ctl) THEN 374 CALL lim_var_glo2eqv 375 379 376 CALL prt_ctl_info(' ') 380 377 CALL prt_ctl_info(' - Cell values : ') … … 531 528 DO jj = 2, jpjm1 532 529 DO ji = 2, jpim1 533 IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > epsi10) THEN ! ice is present530 IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp) THEN 534 531 zworka(ji,jj) = ( 4.0 * strength(ji,jj) & 535 532 & + strength(ji-1,jj) * tmask(ji-1,jj,1) + strength(ji+1,jj) * tmask(ji+1,jj,1) & … … 566 563 DO jj = 1, jpj - 1 567 564 DO ji = 1, jpi - 1 568 IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > epsi10) THEN ! ice is present565 IF ( ( asum(ji,jj) - ato_i(ji,jj) ) > 0._wp) THEN 569 566 numts_rm = 1 ! number of time steps for the running mean 570 567 IF ( strp1(ji,jj) > 0.0 ) numts_rm = numts_rm + 1 … … 637 634 638 635 Gsum(:,:,-1) = 0._wp 639 640 DO jj = 1, jpj 641 DO ji = 1, jpi 642 IF( ato_i(ji,jj) > epsi10 ) THEN ; Gsum(ji,jj,0) = ato_i(ji,jj) 643 ELSE ; Gsum(ji,jj,0) = 0._wp 644 ENDIF 645 END DO 646 END DO 636 Gsum(:,:,0 ) = ato_i(:,:) 647 637 648 638 ! for each value of h, you have to add ice concentration then 649 639 DO jl = 1, jpl 650 DO jj = 1, jpj 651 DO ji = 1, jpi 652 IF( a_i(ji,jj,jl) > epsi10 ) THEN ; Gsum(ji,jj,jl) = Gsum(ji,jj,jl-1) + a_i(ji,jj,jl) 653 ELSE ; Gsum(ji,jj,jl) = Gsum(ji,jj,jl-1) 654 ENDIF 655 END DO 656 END DO 640 Gsum(:,:,jl) = Gsum(:,:,jl-1) + a_i(:,:,jl) 657 641 END DO 658 642 … … 828 812 LOGICAL, PARAMETER :: l_conservation_check = .true. ! if true, check conservation (useful for debugging) 829 813 ! 830 LOGICAL :: neg_ato_i ! flag for ato_i(i,j) < -puny831 LOGICAL :: large_afrac ! flag for afrac > 1832 LOGICAL :: large_afrft ! flag for afrac > 1833 814 INTEGER :: ji, jj, jl, jl1, jl2, jk ! dummy loop indices 834 815 INTEGER :: ij ! horizontal index, combines i and j loops … … 850 831 REAL(wp), POINTER, DIMENSION(:,:) :: ardg1 , ardg2 ! area of ice ridged & new ridges 851 832 REAL(wp), POINTER, DIMENSION(:,:) :: vsrdg , esrdg ! snow volume & energy of ridging ice 852 REAL(wp), POINTER, DIMENSION(:,:) :: oirdg1, oirdg2 ! areal age content of ridged & rifging ice853 833 REAL(wp), POINTER, DIMENSION(:,:) :: dhr , dhr2 ! hrmax - hrmin & hrmax^2 - hrmin^2 854 834 … … 859 839 REAL(wp), POINTER, DIMENSION(:,:) :: srdg2 ! sal*volume of new ridges 860 840 REAL(wp), POINTER, DIMENSION(:,:) :: smsw ! sal*volume of water trapped into ridges 841 REAL(wp), POINTER, DIMENSION(:,:) :: oirdg1, oirdg2 ! ice age of ice ridged 861 842 862 843 REAL(wp), POINTER, DIMENSION(:,:) :: afrft ! fraction of category area rafted … … 864 845 REAL(wp), POINTER, DIMENSION(:,:) :: virft , vsrft ! ice & snow volume of rafting ice 865 846 REAL(wp), POINTER, DIMENSION(:,:) :: esrft , smrft ! snow energy & salinity of rafting ice 866 REAL(wp), POINTER, DIMENSION(:,:) :: oirft1, oirft2 ! areal age content of rafted ice & rafting ice847 REAL(wp), POINTER, DIMENSION(:,:) :: oirft1, oirft2 ! ice age of ice rafted 867 848 868 849 REAL(wp), POINTER, DIMENSION(:,:,:) :: eirft ! ice energy of rafting ice … … 872 853 !!---------------------------------------------------------------------- 873 854 874 CALL wrk_alloc( (jpi+1)*(jpj+1), indxi, indxj )875 CALL wrk_alloc( jpi, jpj, vice_init, vice_final, eice_init, eice_final )876 CALL wrk_alloc( jpi, jpj, afrac, fvol , ardg1, ardg2, vsrdg, esrdg, oirdg1, oirdg2, dhr, dhr2 )877 CALL wrk_alloc( jpi, jpj, vrdg1, vrdg2, vsw , srdg1, srdg2, smsw)878 CALL wrk_alloc( jpi, jpj, afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 )879 CALL wrk_alloc( jpi, jpj, jpl, aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init )880 CALL wrk_alloc( jpi, jpj, nlay_i +1, eirft, erdg1, erdg2, ersw )881 CALL wrk_alloc( jpi, jpj, nlay_i +1, jpl, eicen_init )855 CALL wrk_alloc( (jpi+1)*(jpj+1), indxi, indxj ) 856 CALL wrk_alloc( jpi, jpj, vice_init, vice_final, eice_init, eice_final ) 857 CALL wrk_alloc( jpi, jpj, afrac, fvol , ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 ) 858 CALL wrk_alloc( jpi, jpj, vrdg1, vrdg2, vsw , srdg1, srdg2, smsw, oirdg1, oirdg2 ) 859 CALL wrk_alloc( jpi, jpj, afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 860 CALL wrk_alloc( jpi, jpj, jpl, aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init ) 861 CALL wrk_alloc( jpi, jpj, nlay_i, eirft, erdg1, erdg2, ersw ) 862 CALL wrk_alloc( jpi, jpj, nlay_i, jpl, eicen_init ) 882 863 883 864 ! Conservation check … … 898 879 ! 1) Compute change in open water area due to closing and opening. 899 880 !------------------------------------------------------------------------------- 900 901 neg_ato_i = .false.902 903 881 DO jj = 1, jpj 904 882 DO ji = 1, jpi 905 883 ato_i(ji,jj) = ato_i(ji,jj) - athorn(ji,jj,0) * closing_gross(ji,jj) * rdt_ice & 906 884 & + opning(ji,jj) * rdt_ice 907 IF ( ato_i(ji,jj) < -epsi10 ) THEN908 neg_ato_i = .TRUE.909 ELSEIF( ato_i(ji,jj) < 0._wp ) THEN ! roundoff error885 IF ( ato_i(ji,jj) < -epsi10 ) THEN ! there is a bug 886 IF(lwp) WRITE(numout,*) 'Ridging error: ato_i < 0 -- ato_i : ',ato_i(ji,jj) 887 ELSEIF( ato_i(ji,jj) < 0._wp ) THEN ! roundoff error 910 888 ato_i(ji,jj) = 0._wp 911 889 ENDIF 912 890 END DO 913 891 END DO 914 915 ! if negative open water area alert it916 IF( neg_ato_i .AND. lwp ) THEN ! there is a bug917 DO jj = 1, jpj918 DO ji = 1, jpi919 IF( ato_i(ji,jj) < -epsi10 ) THEN920 WRITE(numout,*) ''921 WRITE(numout,*) 'Ridging error: ato_i < 0'922 WRITE(numout,*) 'ato_i : ', ato_i(ji,jj)923 ENDIF924 END DO925 END DO926 ENDIF927 892 928 893 !----------------------------------------------------------------- 929 894 ! 2) Save initial state variables 930 895 !----------------------------------------------------------------- 931 932 DO jl = 1, jpl 933 aicen_init(:,:,jl) = a_i(:,:,jl) 934 vicen_init(:,:,jl) = v_i(:,:,jl) 935 vsnwn_init(:,:,jl) = v_s(:,:,jl) 936 ! 937 smv_i_init(:,:,jl) = smv_i(:,:,jl) 938 oa_i_init (:,:,jl) = oa_i (:,:,jl) 939 END DO 940 941 esnwn_init(:,:,:) = e_s(:,:,1,:) 942 943 DO jl = 1, jpl 944 DO jk = 1, nlay_i 945 eicen_init(:,:,jk,jl) = e_i(:,:,jk,jl) 946 END DO 947 END DO 896 aicen_init(:,:,:) = a_i (:,:,:) 897 vicen_init(:,:,:) = v_i (:,:,:) 898 vsnwn_init(:,:,:) = v_s (:,:,:) 899 smv_i_init(:,:,:) = smv_i(:,:,:) 900 esnwn_init(:,:,:) = e_s (:,:,1,:) 901 eicen_init(:,:,:,:) = e_i (:,:,:,:) 902 oa_i_init (:,:,:) = oa_i (:,:,:) 948 903 949 904 ! … … 972 927 END DO 973 928 974 large_afrac = .false.975 large_afrft = .false.976 977 929 DO ij = 1, icells 978 930 ji = indxi(ij) … … 988 940 arft2(ji,jj) = arft1(ji,jj) / kraft 989 941 990 oirdg1(ji,jj)= aridge(ji,jj,jl1)*closing_gross(ji,jj)*rdt_ice991 oirft1(ji,jj)= araft (ji,jj,jl1)*closing_gross(ji,jj)*rdt_ice992 oirdg2(ji,jj)= oirdg1(ji,jj) / krdg(ji,jj,jl1)993 oirft2(ji,jj)= oirft1(ji,jj) / kraft994 995 942 !--------------------------------------------------------------- 996 943 ! 3.3) Compute ridging /rafting fractions, make sure afrac <=1 … … 1000 947 afrft(ji,jj) = arft1(ji,jj) / aicen_init(ji,jj,jl1) !rafting 1001 948 1002 IF (afrac(ji,jj) > kamax + epsi10) THEN !riging1003 large_afrac = .true.1004 ELSEIF (afrac(ji,jj) > kamax) THEN! roundoff error949 IF( afrac(ji,jj) > kamax + epsi10 ) THEN ! there is a bug 950 IF(lwp) WRITE(numout,*) ' ardg > a_i -- ardg, aicen_init : ', ardg1(ji,jj), aicen_init(ji,jj,jl1) 951 ELSEIF( afrac(ji,jj) > kamax ) THEN ! roundoff error 1005 952 afrac(ji,jj) = kamax 1006 953 ENDIF 1007 IF (afrft(ji,jj) > kamax + epsi10) THEN !rafting 1008 large_afrft = .true. 1009 ELSEIF (afrft(ji,jj) > kamax) THEN ! roundoff error 954 955 IF( afrft(ji,jj) > kamax + epsi10 ) THEN ! there is a bug 956 IF(lwp) WRITE(numout,*) ' arft > a_i -- arft, aicen_init : ', arft1(ji,jj), aicen_init(ji,jj,jl1) 957 ELSEIF( afrft(ji,jj) > kamax) THEN ! roundoff error 1010 958 afrft(ji,jj) = kamax 1011 959 ENDIF … … 1019 967 vsw (ji,jj) = vrdg1(ji,jj) * rn_por_rdg 1020 968 1021 vsrdg(ji,jj) = vsnwn_init(ji,jj,jl1) * afrac(ji,jj) 1022 esrdg(ji,jj) = esnwn_init(ji,jj,jl1) * afrac(ji,jj) 1023 srdg1(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) 1024 srdg2(ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) !! MV HC 2014 this line seems useless 969 vsrdg (ji,jj) = vsnwn_init(ji,jj,jl1) * afrac(ji,jj) 970 esrdg (ji,jj) = esnwn_init(ji,jj,jl1) * afrac(ji,jj) 971 srdg1 (ji,jj) = smv_i_init(ji,jj,jl1) * afrac(ji,jj) 972 oirdg1(ji,jj) = oa_i_init (ji,jj,jl1) * afrac(ji,jj) 973 oirdg2(ji,jj) = oa_i_init (ji,jj,jl1) * afrac(ji,jj) / krdg(ji,jj,jl1) 1025 974 1026 975 ! rafting volumes, heat contents ... 1027 virft(ji,jj) = vicen_init(ji,jj,jl1) * afrft(ji,jj) 1028 vsrft(ji,jj) = vsnwn_init(ji,jj,jl1) * afrft(ji,jj) 1029 esrft(ji,jj) = esnwn_init(ji,jj,jl1) * afrft(ji,jj) 1030 smrft(ji,jj) = smv_i_init(ji,jj,jl1) * afrft(ji,jj) 976 virft (ji,jj) = vicen_init(ji,jj,jl1) * afrft(ji,jj) 977 vsrft (ji,jj) = vsnwn_init(ji,jj,jl1) * afrft(ji,jj) 978 esrft (ji,jj) = esnwn_init(ji,jj,jl1) * afrft(ji,jj) 979 smrft (ji,jj) = smv_i_init(ji,jj,jl1) * afrft(ji,jj) 980 oirft1(ji,jj) = oa_i_init (ji,jj,jl1) * afrft(ji,jj) 981 oirft2(ji,jj) = oa_i_init (ji,jj,jl1) * afrft(ji,jj) / kraft 1031 982 1032 983 ! substract everything 1033 a_i(ji,jj,jl1) = a_i(ji,jj,jl1) - ardg1(ji,jj) - arft1(ji,jj) 1034 v_i(ji,jj,jl1) = v_i(ji,jj,jl1) - vrdg1(ji,jj) - virft(ji,jj) 1035 v_s(ji,jj,jl1) = v_s(ji,jj,jl1) - vsrdg(ji,jj) - vsrft(ji,jj) 1036 e_s(ji,jj,1,jl1) = e_s(ji,jj,1,jl1) - esrdg(ji,jj) - esrft(ji,jj) 984 a_i(ji,jj,jl1) = a_i(ji,jj,jl1) - ardg1 (ji,jj) - arft1 (ji,jj) 985 v_i(ji,jj,jl1) = v_i(ji,jj,jl1) - vrdg1 (ji,jj) - virft (ji,jj) 986 v_s(ji,jj,jl1) = v_s(ji,jj,jl1) - vsrdg (ji,jj) - vsrft (ji,jj) 987 e_s(ji,jj,1,jl1) = e_s(ji,jj,1,jl1) - esrdg (ji,jj) - esrft (ji,jj) 988 smv_i(ji,jj,jl1) = smv_i(ji,jj,jl1) - srdg1 (ji,jj) - smrft (ji,jj) 1037 989 oa_i(ji,jj,jl1) = oa_i(ji,jj,jl1) - oirdg1(ji,jj) - oirft1(ji,jj) 1038 smv_i(ji,jj,jl1) = smv_i(ji,jj,jl1) - srdg1(ji,jj) - smrft(ji,jj)1039 990 1040 991 !----------------------------------------------------------------- 1041 992 ! 3.5) Compute properties of new ridges 1042 993 !----------------------------------------------------------------- 1043 !--------- ----994 !--------- 1044 995 ! Salinity 1045 !--------- ----996 !--------- 1046 997 smsw(ji,jj) = vsw(ji,jj) * sss_m(ji,jj) ! salt content of seawater frozen in voids !! MV HC2014 1047 998 srdg2(ji,jj) = srdg1(ji,jj) + smsw(ji,jj) ! salt content of new ridge … … 1050 1001 1051 1002 sfx_dyn(ji,jj) = sfx_dyn(ji,jj) - smsw(ji,jj) * rhoic * r1_rdtice 1052 wfx_dyn(ji,jj) = wfx_dyn(ji,jj) - vsw (ji,jj) * rhoic * r1_rdtice ! gurvan:increase in ice volume du to seawater frozen in voids1003 wfx_dyn(ji,jj) = wfx_dyn(ji,jj) - vsw (ji,jj) * rhoic * r1_rdtice ! increase in ice volume du to seawater frozen in voids 1053 1004 1054 1005 !------------------------------------ … … 1134 1085 ENDIF 1135 1086 1136 IF( large_afrac .AND. lwp ) THEN ! there is a bug1137 DO ij = 1, icells1138 ji = indxi(ij)1139 jj = indxj(ij)1140 IF( afrac(ji,jj) > kamax + epsi10 ) THEN1141 WRITE(numout,*) ''1142 WRITE(numout,*) ' ardg > a_i'1143 WRITE(numout,*) ' ardg, aicen_init : ', ardg1(ji,jj), aicen_init(ji,jj,jl1)1144 ENDIF1145 END DO1146 ENDIF1147 IF( large_afrft .AND. lwp ) THEN ! there is a bug1148 DO ij = 1, icells1149 ji = indxi(ij)1150 jj = indxj(ij)1151 IF( afrft(ji,jj) > kamax + epsi10 ) THEN1152 WRITE(numout,*) ''1153 WRITE(numout,*) ' arft > a_i'1154 WRITE(numout,*) ' arft, aicen_init : ', arft1(ji,jj), aicen_init(ji,jj,jl1)1155 ENDIF1156 END DO1157 ENDIF1158 1159 1087 !------------------------------------------------------------------------------- 1160 1088 ! 4) Add area, volume, and energy of new ridge to each category jl2 … … 1190 1118 oa_i (ji,jj ,jl2) = oa_i (ji,jj ,jl2) + oirdg2(ji,jj) * farea 1191 1119 1192 END DO ! ij1120 END DO 1193 1121 1194 1122 ! Transfer ice energy to category jl2 by ridging … … 1217 1145 e_s (ji,jj,1,jl2) = e_s (ji,jj,1,jl2) + esrft (ji,jj) * rn_fsnowrft 1218 1146 smv_i(ji,jj ,jl2) = smv_i(ji,jj ,jl2) + smrft (ji,jj) 1219 oa_i (ji,jj ,jl2) = oa_i (ji,jj ,jl2) + oirft2(ji,jj) 1147 oa_i (ji,jj ,jl2) = oa_i (ji,jj ,jl2) + oirft2(ji,jj) 1220 1148 ENDIF 1221 1149 ! … … 1257 1185 ENDIF 1258 1186 ! 1259 CALL wrk_dealloc( (jpi+1)*(jpj+1), indxi, indxj )1260 CALL wrk_dealloc( jpi, jpj, vice_init, vice_final, eice_init, eice_final )1261 CALL wrk_dealloc( jpi, jpj, afrac, fvol , ardg1, ardg2, vsrdg, esrdg, oirdg1, oirdg2, dhr, dhr2 )1262 CALL wrk_dealloc( jpi, jpj, vrdg1, vrdg2, vsw , srdg1, srdg2, smsw)1263 CALL wrk_dealloc( jpi, jpj, afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 )1264 CALL wrk_dealloc( jpi, jpj, jpl, aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init )1265 CALL wrk_dealloc( jpi, jpj, nlay_i +1,eirft, erdg1, erdg2, ersw )1266 CALL wrk_dealloc( jpi, jpj, nlay_i +1, jpl,eicen_init )1187 CALL wrk_dealloc( (jpi+1)*(jpj+1), indxi, indxj ) 1188 CALL wrk_dealloc( jpi, jpj, vice_init, vice_final, eice_init, eice_final ) 1189 CALL wrk_dealloc( jpi, jpj, afrac, fvol , ardg1, ardg2, vsrdg, esrdg, dhr, dhr2 ) 1190 CALL wrk_dealloc( jpi, jpj, vrdg1, vrdg2, vsw , srdg1, srdg2, smsw, oirdg1, oirdg2 ) 1191 CALL wrk_dealloc( jpi, jpj, afrft, arft1, arft2, virft, vsrft, esrft, smrft, oirft1, oirft2 ) 1192 CALL wrk_dealloc( jpi, jpj, jpl, aicen_init, vicen_init, vsnwn_init, esnwn_init, smv_i_init, oa_i_init ) 1193 CALL wrk_dealloc( jpi, jpj, nlay_i, eirft, erdg1, erdg2, ersw ) 1194 CALL wrk_dealloc( jpi, jpj, nlay_i, jpl, eicen_init ) 1267 1195 ! 1268 1196 END SUBROUTINE lim_itd_me_ridgeshift -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90
r5134 r5350 130 130 rswitch = MAX( 0.0, SIGN( 1.0, a_i_b(ji,jj,jl) - epsi10) ) !0 if no ice and 1 if yes 131 131 zht_i_b(ji,jj,jl) = v_i_b(ji,jj,jl) / MAX( a_i_b(ji,jj,jl), epsi10 ) * rswitch 132 !clem IF( a_i(ji,jj,jl) > epsi10 ) zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_b(ji,jj,jl)133 132 zdhice(ji,jj,jl) = ht_i(ji,jj,jl) - zht_i_b(ji,jj,jl) 134 133 END DO … … 737 736 REAL(wp), POINTER, DIMENSION(:,:) :: vt_s_init, vt_s_final ! snow volume summed over categories 738 737 !!------------------------------------------------------------------ 739 !! clem 2014/04: be carefull, rebining does not conserve salt(maybe?) => the difference is taken into account in limupdate740 738 741 739 CALL wrk_alloc( jpi,jpj,jpl, zdonor ) ! interger … … 844 842 zdvice(:,:,jl) = 0._wp 845 843 ENDIF 846 847 ! ! clem-change begin: why not doing that?848 ! DO jj = 1, jpj849 ! DO ji = 1, jpi850 ! IF( a_i(ji,jj,jl+1) > epsi10 .AND. ht_i(ji,jj,jl+1) <= hi_max(jl) ) THEN851 ! ht_i(ji,jj,jl+1) = hi_max(jl) + epsi10852 ! a_i (ji,jj,jl+1) = v_i(ji,jj,jl+1) / ht_i(ji,jj,jl+1)853 ! ENDIF854 ! END DO855 ! END DO856 ! clem-change end857 844 858 845 END DO -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90
r5128 r5350 55 55 CHARACTER(LEN=20) :: clkt ! ocean time-step define as a character 56 56 CHARACTER(LEN=50) :: clname ! ice output restart file name 57 CHARACTER(len=256) :: clpath ! full path to ice output restart file 57 58 !!---------------------------------------------------------------------- 58 59 ! … … 64 65 IF( kt == nitrst - 2*nn_fsbc + 1 .OR. nstock == nn_fsbc & 65 66 & .OR. ( kt == nitend - nn_fsbc + 1 .AND. .NOT. lrst_ice ) ) THEN 66 ! beware of the format used to write kt (default is i8.8, that should be large enough...) 67 IF( nitrst > 99999999 ) THEN ; WRITE(clkt, * ) nitrst 68 ELSE ; WRITE(clkt, '(i8.8)') nitrst 67 IF( nitrst <= nitend .AND. nitrst > 0 ) THEN 68 ! beware of the format used to write kt (default is i8.8, that should be large enough...) 69 IF( nitrst > 99999999 ) THEN ; WRITE(clkt, * ) nitrst 70 ELSE ; WRITE(clkt, '(i8.8)') nitrst 71 ENDIF 72 ! create the file 73 clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_icerst_out) 74 clpath = TRIM(cn_icerst_outdir) 75 IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath)//'/' 76 IF(lwp) THEN 77 WRITE(numout,*) 78 SELECT CASE ( jprstlib ) 79 CASE ( jprstdimg ) 80 WRITE(numout,*) ' open ice restart binary file: ',TRIM(clpath)//clname 81 CASE DEFAULT 82 WRITE(numout,*) ' open ice restart NetCDF file: ',TRIM(clpath)//clname 83 END SELECT 84 IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN 85 WRITE(numout,*) ' kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp 86 ELSE ; WRITE(numout,*) ' kt = ' , kt,' date= ', ndastp 87 ENDIF 88 ENDIF 89 ! 90 CALL iom_open( TRIM(clpath)//TRIM(clname), numriw, ldwrt = .TRUE., kiolib = jprstlib ) 91 lrst_ice = .TRUE. 69 92 ENDIF 70 ! create the file71 clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_icerst_out)72 IF(lwp) THEN73 WRITE(numout,*)74 SELECT CASE ( jprstlib )75 CASE ( jprstdimg ) ; WRITE(numout,*) ' open ice restart binary file: '//clname76 CASE DEFAULT ; WRITE(numout,*) ' open ice restart NetCDF file: '//clname77 END SELECT78 IF( kt == nitrst - 2*nn_fsbc + 1 ) THEN79 WRITE(numout,*) ' kt = nitrst - 2*nn_fsbc + 1 = ', kt,' date= ', ndastp80 ELSE ; WRITE(numout,*) ' kt = ' , kt,' date= ', ndastp81 ENDIF82 ENDIF83 !84 CALL iom_open( clname, numriw, ldwrt = .TRUE., kiolib = jprstlib )85 lrst_ice = .TRUE.86 93 ENDIF 87 94 ! … … 143 150 CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 144 151 END DO 145 152 146 153 DO jl = 1, jpl 147 154 WRITE(zchar,'(I1)') jl … … 327 334 ! eventually read netcdf file (monobloc) for restarting on different number of processors 328 335 ! if {cn_icerst_in}.nc exists, then set jlibalt to jpnf90 329 INQUIRE( FILE = TRIM(cn_icerst_in )//'.nc', EXIST = llok )336 INQUIRE( FILE = TRIM(cn_icerst_indir)//'/'//TRIM(cn_icerst_in)//'.nc', EXIST = llok ) 330 337 IF ( llok ) THEN ; jlibalt = jpnf90 ; ELSE ; jlibalt = jprstlib ; ENDIF 331 338 ENDIF 332 339 333 CALL iom_open ( cn_icerst_in, numrir, kiolib = jprstlib )340 CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir, kiolib = jprstlib ) 334 341 335 342 CALL iom_get( numrir, 'nn_fsbc', zfice ) -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r5128 r5350 42 42 USE domvvl ! Variable volume 43 43 USE limctl 44 USE limcons 44 45 45 46 IMPLICIT NONE … … 146 147 hfx_out(ji,jj) = hfx_out(ji,jj) + zf_mass + zfcm1 147 148 149 ! Add the residual from heat diffusion equation (W.m-2) 150 !------------------------------------------------------- 151 hfx_out(ji,jj) = hfx_out(ji,jj) + hfx_err_dif(ji,jj) 152 148 153 ! New qsr and qns used to compute the oceanic heat flux at the next time step 149 154 !--------------------------------------------------- … … 164 169 ! computing freshwater exchanges at the ice/ocean interface 165 170 IF( lk_cpl ) THEN 166 zemp = - emp_tot(ji,jj) + emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) ) & ! 167 & + wfx_snw(ji,jj) 171 zemp = emp_tot(ji,jj) & ! net mass flux over grid cell 172 & - emp_ice(ji,jj) * ( 1._wp - pfrld(ji,jj) ) & ! minus the mass flux intercepted by sea ice 173 & + sprecip(ji,jj) * ( pfrld(ji,jj) - pfrld(ji,jj)**rn_betas ) ! 168 174 ELSE 169 175 zemp = emp(ji,jj) * pfrld(ji,jj) & ! evaporation over oceanic fraction … … 177 183 178 184 ! mass flux at the ocean/ice interface 179 fmmflx(ji,jj) = - wfx_ice(ji,jj) * r1_rdtice! F/M mass flux save at least for biogeochemical model180 emp(ji,jj) = zemp - wfx_ice(ji,jj) - wfx_snw(ji,jj) ! mass flux + F/M mass flux (always ice/ocean mass exchange)185 fmmflx(ji,jj) = - ( wfx_ice(ji,jj) + wfx_snw(ji,jj) ) * r1_rdtice ! F/M mass flux save at least for biogeochemical model 186 emp(ji,jj) = zemp - wfx_ice(ji,jj) - wfx_snw(ji,jj) ! mass flux + F/M mass flux (always ice/ocean mass exchange) 181 187 182 188 END DO … … 222 228 ENDIF 223 229 224 IF( ln_icectl ) CALL lim_prt( kt, iiceprt, jiceprt, 3, ' - Final state lim_sbc - ' ) ! control print 230 ! conservation test 231 IF( ln_limdiahsb ) CALL lim_cons_final( 'limsbc' ) 232 233 ! control prints 234 IF( ln_icectl ) CALL lim_prt( kt, iiceprt, jiceprt, 3, ' - Final state lim_sbc - ' ) 225 235 226 236 IF(ln_ctl) THEN -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r5134 r5350 89 89 REAL(wp) :: zfric_u, zqld, zqfr 90 90 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 91 REAL(wp), PARAMETER :: zfric_umin = 0._wp ! lower bound for the friction velocity (cice value=5.e-04)92 REAL(wp), PARAMETER :: zch = 0.0057_wp ! heat transfer coefficient91 REAL(wp), PARAMETER :: zfric_umin = 0._wp ! lower bound for the friction velocity (cice value=5.e-04) 92 REAL(wp), PARAMETER :: zch = 0.0057_wp ! heat transfer coefficient 93 93 ! 94 94 REAL(wp), POINTER, DIMENSION(:,:) :: zqsr, zqns 95 95 !!------------------------------------------------------------------- 96 CALL wrk_alloc( jpi, 96 CALL wrk_alloc( jpi,jpj, zqsr, zqns ) 97 97 98 98 IF( nn_timing == 1 ) CALL timing_start('limthd') … … 101 101 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 102 102 103 CALL lim_var_glo2eqv 103 104 !------------------------------------------------------------------------! 104 105 ! 1) Initialization of some variables ! … … 209 210 ! Net heat flux on top of ice-ocean [W.m-2] 210 211 ! ----------------------------------------- 211 ! First step here :heat flux at the ocean surface + precip212 ! Second step below : heat flux at the ice surface (after limthd_dif)212 ! heat flux at the ocean surface + precip 213 ! + heat flux at the ice surface 213 214 hfx_in(ji,jj) = hfx_in(ji,jj) & 214 215 ! heat flux above the ocean … … 216 217 ! latent heat of precip (note that precip is included in qns but not in qns_ice) 217 218 & + ( 1._wp - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt0 ) - lfus ) & 218 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt0 ) 219 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt0 ) & 220 ! heat flux above the ice 221 & + SUM( a_i_b(ji,jj,:) * ( qns_ice(ji,jj,:) + qsr_ice(ji,jj,:) ) ) 219 222 220 223 ! ----------------------------------------------------------------------------- … … 226 229 hfx_out(ji,jj) = hfx_out(ji,jj) & 227 230 ! Non solar heat flux received by the ocean 228 & + pfrld(ji,jj) * qns(ji,jj) &231 & + pfrld(ji,jj) * zqns(ji,jj) & 229 232 ! latent heat of precip (note that precip is included in qns but not in qns_ice) 230 233 & + ( pfrld(ji,jj)**rn_betas - pfrld(ji,jj) ) * sprecip(ji,jj) & … … 311 314 ! --- lateral melting if monocat --- ! 312 315 !------------------------------------! 313 IF ( ( ( nn_monocat == 1 ) .OR. ( nn_monocat == 4 ) ) .AND. ( jpl == 1 )) THEN316 IF ( ( nn_monocat == 1 .OR. nn_monocat == 4 ) .AND. jpl == 1 ) THEN 314 317 CALL lim_thd_lam( 1, nbpb ) 315 318 END IF … … 324 327 ENDIF 325 328 ! 326 END DO 329 END DO !jl 327 330 328 331 !------------------------------------------------------------------------------! … … 350 353 END DO 351 354 352 !------------------------353 ! Ice natural aging354 !------------------------355 oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * rdt_ice /rday356 357 355 !---------------------------------- 358 356 ! Change thickness to volume 359 357 !---------------------------------- 360 CALL lim_var_eqv2glo 358 v_i(:,:,:) = ht_i(:,:,:) * a_i(:,:,:) 359 v_s(:,:,:) = ht_s(:,:,:) * a_i(:,:,:) 360 smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:) 361 362 ! update ice age (in case a_i changed, i.e. becomes 0 or lateral melting in monocat) 363 DO jl = 1, jpl 364 DO jj = 1, jpj 365 DO ji = 1, jpi 366 rswitch = MAX( 0._wp , SIGN( 1._wp, a_i_b(ji,jj,jl) - epsi10 ) ) 367 oa_i(ji,jj,jl) = rswitch * oa_i(ji,jj,jl) * a_i(ji,jj,jl) / MAX( a_i_b(ji,jj,jl), epsi10 ) 368 END DO 369 END DO 370 END DO 361 371 362 372 CALL lim_var_zapsmall 373 363 374 !-------------------------------------------- 364 375 ! Diagnostic thermodynamic growth rates … … 399 410 ! 400 411 ! 401 CALL wrk_dealloc( jpi, jpj, zqsr, zqns )402 403 412 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 413 414 CALL wrk_dealloc( jpi,jpj, zqsr, zqns ) 415 404 416 !------------------------------------------------------------------------------| 405 417 ! 6) Transport of ice between thickness categories. | 406 418 !------------------------------------------------------------------------------| 419 ! Given thermodynamic growth rates, transport ice between thickness categories. 407 420 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 408 421 409 ! Given thermodynamic growth rates, transport ice between thickness categories. 410 IF( jpl > 1 ) CALL lim_itd_th_rem( 1, jpl, kt ) 411 ! 412 CALL lim_var_glo2eqv ! only for info 413 CALL lim_var_agg(1) 422 IF( jpl > 1 ) CALL lim_itd_th_rem( 1, jpl, kt ) 414 423 415 424 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 425 416 426 !------------------------------------------------------------------------------| 417 427 ! 7) Add frazil ice growing in leads. 418 428 !------------------------------------------------------------------------------| 419 429 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 430 420 431 CALL lim_thd_lac 421 CALL lim_var_glo2eqv ! only for info422 432 423 ! conservation test424 433 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 425 434 426 IF(ln_ctl) THEN ! Control print 435 ! Control print 436 IF(ln_ctl) THEN 437 CALL lim_var_glo2eqv 438 427 439 CALL prt_ctl_info(' ') 428 440 CALL prt_ctl_info(' - Cell values : ') … … 503 515 REAL(wp) :: zhi_bef ! ice thickness before thermo 504 516 REAL(wp) :: zdh_mel, zda_mel ! net melting 505 REAL(wp) :: zv ! ice volume517 REAL(wp) :: zvi, zvs ! ice/snow volumes 506 518 507 519 DO ji = kideb, kiut 508 520 zdh_mel = MIN( 0._wp, dh_i_surf(ji) + dh_i_bott(ji) + dh_snowice(ji) ) 509 IF( zdh_mel < 0._wp ) THEN 510 zv = a_i_1d(ji) * ht_i_1d(ji) 521 IF( zdh_mel < 0._wp .AND. a_i_1d(ji) > 0._wp ) THEN 522 zvi = a_i_1d(ji) * ht_i_1d(ji) 523 zvs = a_i_1d(ji) * ht_s_1d(ji) 511 524 ! lateral melting = concentration change 512 525 zhi_bef = ht_i_1d(ji) - zdh_mel 513 zda_mel = a_i_1d(ji) * zdh_mel / ( 2._wp * MAX( zhi_bef, epsi10 ) ) 514 a_i_1d(ji) = MAX( 0._wp, a_i_1d(ji) + zda_mel ) 515 ! adjust thickness 516 rswitch = MAX( 0._wp , SIGN( 1._wp , a_i_1d(ji) - epsi20 ) ) 517 ht_i_1d(ji) = rswitch * zv / MAX( a_i_1d(ji), epsi20 ) 526 rswitch = MAX( 0._wp , SIGN( 1._wp , zhi_bef - epsi20 ) ) 527 zda_mel = rswitch * a_i_1d(ji) * zdh_mel / ( 2._wp * MAX( zhi_bef, epsi20 ) ) 528 a_i_1d(ji) = MAX( epsi20, a_i_1d(ji) + zda_mel ) 529 ! adjust thickness 530 ht_i_1d(ji) = zvi / a_i_1d(ji) 531 ht_s_1d(ji) = zvs / a_i_1d(ji) 518 532 ! retrieve total concentration 519 533 at_i_1d(ji) = a_i_1d(ji) … … 601 615 CALL tab_2d_1d( nbpb, hfx_err_1d (1:nbpb), hfx_err , jpi, jpj, npb(1:nbpb) ) 602 616 CALL tab_2d_1d( nbpb, hfx_res_1d (1:nbpb), hfx_res , jpi, jpj, npb(1:nbpb) ) 617 CALL tab_2d_1d( nbpb, hfx_err_dif_1d (1:nbpb), hfx_err_dif , jpi, jpj, npb(1:nbpb) ) 603 618 CALL tab_2d_1d( nbpb, hfx_err_rem_1d (1:nbpb), hfx_err_rem , jpi, jpj, npb(1:nbpb) ) 604 619 … … 651 666 CALL tab_1d_2d( nbpb, hfx_res , npb, hfx_res_1d(1:nbpb) , jpi, jpj ) 652 667 CALL tab_1d_2d( nbpb, hfx_err_rem , npb, hfx_err_rem_1d(1:nbpb), jpi, jpj ) 668 CALL tab_1d_2d( nbpb, hfx_err_dif , npb, hfx_err_dif_1d(1:nbpb), jpi, jpj ) 653 669 ! 654 670 CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qns_ice_1d(1:nbpb) , jpi, jpj) … … 674 690 INTEGER :: ios ! Local integer output status for namelist read 675 691 NAMELIST/namicethd/ rn_hnewice, ln_frazil, rn_maxfrazb, rn_vfrazb, rn_Cfrazb, & 676 & rn_himin, parsub,rn_betas, rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon, &677 & nn_monocat 692 & rn_himin, rn_betas, rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon, & 693 & nn_monocat, ln_it_qnsice 678 694 !!------------------------------------------------------------------- 679 695 ! … … 698 714 ENDIF 699 715 700 IF( lk_cpl .AND. parsub /= 0.0 ) CALL ctl_stop( 'In coupled mode, use parsub = 0. or send dqla' )701 716 ! 702 717 IF(lwp) THEN ! control print … … 710 725 WRITE(numout,*)' minimum ice thickness rn_himin = ', rn_himin 711 726 WRITE(numout,*)' numerical carac. of the scheme for diffusion in ice ' 712 WRITE(numout,*)' switch for snow sublimation (=1) or not (=0) parsub = ', parsub713 727 WRITE(numout,*)' coefficient for ice-lead partition of snowfall rn_betas = ', rn_betas 714 728 WRITE(numout,*)' extinction radiation parameter in sea ice rn_kappa_i = ', rn_kappa_i … … 718 732 WRITE(numout,*)' check heat conservation in the ice/snow con_i = ', con_i 719 733 WRITE(numout,*)' virtual ITD mono-category parameterizations (1) or not nn_monocat = ', nn_monocat 734 WRITE(numout,*)' iterate the surface non-solar flux (T) or not (F) ln_it_qnsice = ', ln_it_qnsice 720 735 ENDIF 721 736 ! -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
r5134 r5350 86 86 REAL(wp) :: zsstK ! SST in Kelvin 87 87 88 REAL(wp), POINTER, DIMENSION(:) :: zh_s ! snow layer thickness89 88 REAL(wp), POINTER, DIMENSION(:) :: zqprec ! energy of fallen snow (J.m-3) 90 89 REAL(wp), POINTER, DIMENSION(:) :: zq_su ! heat for surface ablation (J.m-2) … … 92 91 REAL(wp), POINTER, DIMENSION(:) :: zq_rema ! remaining heat at the end of the routine (J.m-2) 93 92 REAL(wp), POINTER, DIMENSION(:) :: zf_tt ! Heat budget to determine melting or freezing(W.m-2) 94 INTEGER , POINTER, DIMENSION(:) :: icount ! number of layers vanished by melting95 93 96 94 REAL(wp), POINTER, DIMENSION(:) :: zdh_s_mel ! snow melt … … 100 98 REAL(wp), POINTER, DIMENSION(:,:) :: zdeltah 101 99 REAL(wp), POINTER, DIMENSION(:,:) :: zh_i ! ice layer thickness 100 INTEGER , POINTER, DIMENSION(:,:) :: icount ! number of layers vanished by melting 102 101 103 102 REAL(wp), POINTER, DIMENSION(:) :: zqh_i ! total ice heat content (J.m-2) … … 118 117 END SELECT 119 118 120 CALL wrk_alloc( jpij, z h_s, zqprec, zq_su, zq_bo, zf_tt, zq_rema )119 CALL wrk_alloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema ) 121 120 CALL wrk_alloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s ) 122 CALL wrk_alloc( jpij, nlay_i +1, zdeltah, zh_i )123 CALL wrk_alloc( jpij, icount )121 CALL wrk_alloc( jpij, nlay_i, zdeltah, zh_i ) 122 CALL wrk_alloc( jpij, nlay_i, icount ) 124 123 125 124 dh_i_surf (:) = 0._wp ; dh_i_bott (:) = 0._wp ; dh_snowice(:) = 0._wp … … 129 128 zq_rema(:) = 0._wp 130 129 131 zh_s (:) = 0._wp132 130 zdh_s_pre(:) = 0._wp 133 131 zdh_s_mel(:) = 0._wp … … 138 136 zh_i (:,:) = 0._wp 139 137 zdeltah (:,:) = 0._wp 140 icount (:) = 0 138 icount (:,:) = 0 139 140 ! Initialize enthalpy at nlay_i+1 141 DO ji = kideb, kiut 142 q_i_1d(ji,nlay_i+1) = 0._wp 143 END DO 141 144 142 145 ! initialize layer thicknesses and enthalpies … … 155 158 ! 156 159 DO ji = kideb, kiut 157 rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_s_1d(ji) ) )158 ztmelts = rswitch * rt0 + ( 1._wp - rswitch ) * rt0159 160 160 zfdum = qns_ice_1d(ji) + ( 1._wp - i0(ji) ) * qsr_ice_1d(ji) - fc_su(ji) 161 161 zf_tt(ji) = fc_bo_i(ji) + fhtur_1d(ji) + fhld_1d(ji) 162 162 163 zq_su (ji) = MAX( 0._wp, zfdum * rdt_ice ) * MAX( 0._wp , SIGN( 1._wp, t_su_1d(ji) - ztmelts) )163 zq_su (ji) = MAX( 0._wp, zfdum * rdt_ice ) * MAX( 0._wp , SIGN( 1._wp, t_su_1d(ji) - rt0 ) ) 164 164 zq_bo (ji) = MAX( 0._wp, zf_tt(ji) * rdt_ice ) 165 165 END DO … … 187 187 !------------------------------------------------------------! 188 188 ! 189 DO ji = kideb, kiut190 zh_s(ji) = ht_s_1d(ji) * r1_nlay_s191 END DO192 !193 189 DO jk = 1, nlay_s 194 190 DO ji = kideb, kiut 195 zqh_s(ji) = zqh_s(ji) + q_s_1d(ji,jk) * zh_s(ji)191 zqh_s(ji) = zqh_s(ji) + q_s_1d(ji,jk) * ht_s_1d(ji) * r1_nlay_s 196 192 END DO 197 193 END DO … … 222 218 ! Martin Vancoppenolle, December 2006 223 219 220 zdeltah(:,:) = 0._wp 224 221 DO ji = kideb, kiut 225 222 !----------- … … 236 233 ! mass flux, <0 237 234 wfx_spr_1d(ji) = wfx_spr_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_pre(ji) * r1_rdtice 238 ! update thickness239 ht_s_1d (ji) = MAX( 0._wp , ht_s_1d(ji) + zdh_s_pre(ji) )240 235 241 236 !--------------------- … … 243 238 !--------------------- 244 239 ! thickness change 245 IF( zdh_s_pre(ji) > 0._wp ) THEN246 240 rswitch = MAX( 0._wp , SIGN( 1._wp , zqprec(ji) - epsi20 ) ) 247 zd h_s_mel (ji) = - rswitch * zq_su(ji) / MAX( zqprec(ji) , epsi20 )248 zd h_s_mel (ji) = MAX( - zdh_s_pre(ji), zdh_s_mel(ji) ) ! bound melting241 zdeltah (ji,1) = - rswitch * zq_su(ji) / MAX( zqprec(ji) , epsi20 ) 242 zdeltah (ji,1) = MAX( - zdh_s_pre(ji), zdeltah(ji,1) ) ! bound melting 249 243 ! heat used to melt snow (W.m-2, >0) 250 hfx_snw_1d(ji) = hfx_snw_1d(ji) - zd h_s_mel(ji) * a_i_1d(ji) * zqprec(ji) * r1_rdtice244 hfx_snw_1d(ji) = hfx_snw_1d(ji) - zdeltah(ji,1) * a_i_1d(ji) * zqprec(ji) * r1_rdtice 251 245 ! snow melting only = water into the ocean (then without snow precip), >0 252 wfx_snw_1d(ji) = wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_mel(ji) * r1_rdtice 253 254 ! updates available heat + thickness 255 zq_su (ji) = MAX( 0._wp , zq_su (ji) + zdh_s_mel(ji) * zqprec(ji) ) 256 ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdh_s_mel(ji) ) 257 zh_s (ji) = ht_s_1d(ji) * r1_nlay_s 258 259 ENDIF 260 END DO 261 262 ! If heat still available, then melt more snow 263 zdeltah(:,:) = 0._wp ! important 246 wfx_snw_1d(ji) = wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,1) * r1_rdtice 247 ! updates available heat + precipitations after melting 248 zq_su (ji) = MAX( 0._wp , zq_su (ji) + zdeltah(ji,1) * zqprec(ji) ) 249 zdh_s_pre (ji) = zdh_s_pre(ji) + zdeltah(ji,1) 250 251 ! update thickness 252 ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdh_s_pre(ji) ) 253 END DO 254 255 ! If heat still available (zq_su > 0), then melt more snow 256 zdeltah(:,:) = 0._wp 264 257 DO jk = 1, nlay_s 265 258 DO ji = kideb, kiut … … 268 261 rswitch = rswitch * ( MAX( 0._wp, SIGN( 1._wp, q_s_1d(ji,jk) - epsi20 ) ) ) 269 262 zdeltah (ji,jk) = - rswitch * zq_su(ji) / MAX( q_s_1d(ji,jk), epsi20 ) 270 zdeltah (ji,jk) = MAX( zdeltah(ji,jk) , - zh_s(ji) ) ! bound melting263 zdeltah (ji,jk) = MAX( zdeltah(ji,jk) , - ht_s_1d(ji) ) ! bound melting 271 264 zdh_s_mel(ji) = zdh_s_mel(ji) + zdeltah(ji,jk) 272 265 ! heat used to melt snow(W.m-2, >0) … … 274 267 ! snow melting only = water into the ocean (then without snow precip) 275 268 wfx_snw_1d(ji) = wfx_snw_1d(ji) - rhosn * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice 276 277 269 ! updates available heat + thickness 278 270 zq_su (ji) = MAX( 0._wp , zq_su (ji) + zdeltah(ji,jk) * q_s_1d(ji,jk) ) 279 271 ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdeltah(ji,jk) ) 280 281 272 END DO 282 273 END DO … … 286 277 !---------------------- 287 278 ! qla_ice is always >=0 (upwards), heat goes to the atmosphere, therefore snow sublimates 288 ! clem comment: not counted in mass exchange in limsbc since this is an exchange with atm. (not ocean)279 ! clem comment: not counted in mass/heat exchange in limsbc since this is an exchange with atm. (not ocean) 289 280 ! clem comment: ice should also sublimate 281 zdeltah(:,:) = 0._wp 290 282 IF( lk_cpl ) THEN 291 283 ! coupled mode: sublimation already included in emp_ice (to do in limsbc_ice) … … 294 286 ! forced mode: snow thickness change due to sublimation 295 287 DO ji = kideb, kiut 296 zdh_s_sub(ji) = MAX( - ht_s_1d(ji) , - parsub *qla_ice_1d(ji) / ( rhosn * lsub ) * rdt_ice )288 zdh_s_sub(ji) = MAX( - ht_s_1d(ji) , - qla_ice_1d(ji) / ( rhosn * lsub ) * rdt_ice ) 297 289 ! Heat flux by sublimation [W.m-2], < 0 298 290 ! sublimate first snow that had fallen, then pre-existing snow 299 zcoeff = ( MAX( zdh_s_sub(ji), - MAX( 0._wp, zdh_s_pre(ji) + zdh_s_mel(ji) ) ) * zqprec(ji) + & 300 & ( zdh_s_sub(ji) - MAX( zdh_s_sub(ji), - MAX( 0._wp, zdh_s_pre(ji) + zdh_s_mel(ji) ) ) ) * q_s_1d(ji,1) ) & 301 & * a_i_1d(ji) * r1_rdtice 302 hfx_sub_1d(ji) = hfx_sub_1d(ji) + zcoeff 291 zdeltah(ji,1) = MAX( zdh_s_sub(ji), - zdh_s_pre(ji) ) 292 hfx_sub_1d(ji) = hfx_sub_1d(ji) + ( zdeltah(ji,1) * zqprec(ji) + ( zdh_s_sub(ji) - zdeltah(ji,1) ) * q_s_1d(ji,1) & 293 & ) * a_i_1d(ji) * r1_rdtice 303 294 ! Mass flux by sublimation 304 295 wfx_sub_1d(ji) = wfx_sub_1d(ji) - rhosn * a_i_1d(ji) * zdh_s_sub(ji) * r1_rdtice 305 296 ! new snow thickness 306 ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdh_s_sub(ji) ) 297 ht_s_1d(ji) = MAX( 0._wp , ht_s_1d(ji) + zdh_s_sub(ji) ) 298 ! update precipitations after sublimation and correct sublimation 299 zdh_s_pre(ji) = zdh_s_pre(ji) + zdeltah(ji,1) 300 zdh_s_sub(ji) = zdh_s_sub(ji) - zdeltah(ji,1) 307 301 END DO 308 302 ENDIF … … 310 304 ! --- Update snow diags --- ! 311 305 DO ji = kideb, kiut 312 dh_s_tot(ji) = zdh_s_mel(ji) + zdh_s_pre(ji) + zdh_s_sub(ji) 313 zh_s(ji) = ht_s_1d(ji) * r1_nlay_s 314 END DO ! ji 306 dh_s_tot(ji) = zdh_s_mel(ji) + zdh_s_pre(ji) + zdh_s_sub(ji) 307 END DO 315 308 316 309 !------------------------------------------- … … 323 316 rswitch = MAX( 0._wp , SIGN( 1._wp, ht_s_1d(ji) - epsi20 ) ) 324 317 q_s_1d(ji,jk) = rswitch / MAX( ht_s_1d(ji), epsi20 ) * & 325 & ( ( MAX( 0._wp, dh_s_tot(ji) )) * zqprec(ji) + &326 & ( - MAX( 0._wp, dh_s_tot(ji) ) + ht_s_1d(ji) ) * rhosn * ( cpic * ( rt0 - t_s_1d(ji,jk) ) + lfus ) )318 & ( ( zdh_s_pre(ji) ) * zqprec(ji) + & 319 & ( ht_s_1d(ji) - zdh_s_pre(ji) ) * rhosn * ( cpic * ( rt0 - t_s_1d(ji,jk) ) + lfus ) ) 327 320 zq_s(ji) = zq_s(ji) + q_s_1d(ji,jk) 328 321 END DO … … 334 327 zdeltah(:,:) = 0._wp ! important 335 328 DO jk = 1, nlay_i 336 DO ji = kideb, kiut 337 zEi = - q_i_1d(ji,jk) * r1_rhoic ! Specific enthalpy of layer k [J/kg, <0] 338 339 ztmelts = - tmut * s_i_1d(ji,jk) + rt0 ! Melting point of layer k [K] 340 341 zEw = rcp * ( ztmelts - rt0 ) ! Specific enthalpy of resulting meltwater [J/kg, <0] 342 343 zdE = zEi - zEw ! Specific enthalpy difference < 0 344 345 zfmdt = - zq_su(ji) / zdE ! Mass flux to the ocean [kg/m2, >0] 346 347 zdeltah(ji,jk) = - zfmdt * r1_rhoic ! Melt of layer jk [m, <0] 348 349 zdeltah(ji,jk) = MIN( 0._wp , MAX( zdeltah(ji,jk) , - zh_i(ji,jk) ) ) ! Melt of layer jk cannot exceed the layer thickness [m, <0] 350 351 zq_su(ji) = MAX( 0._wp , zq_su(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat 352 353 dh_i_surf(ji) = dh_i_surf(ji) + zdeltah(ji,jk) ! Cumulate surface melt 354 355 zfmdt = - rhoic * zdeltah(ji,jk) ! Recompute mass flux [kg/m2, >0] 356 357 zQm = zfmdt * zEw ! Energy of the melt water sent to the ocean [J/m2, <0] 358 359 ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok) 360 sfx_sum_1d(ji) = sfx_sum_1d(ji) - sm_i_1d(ji) * a_i_1d(ji) * zdeltah(ji,jk) * rhoic * r1_rdtice 361 362 ! Contribution to heat flux [W.m-2], < 0 363 hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice 364 365 ! Total heat flux used in this process [W.m-2], > 0 366 hfx_sum_1d(ji) = hfx_sum_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice 367 368 ! Contribution to mass flux 369 wfx_sum_1d(ji) = wfx_sum_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice 370 329 DO ji = kideb, kiut 330 ztmelts = - tmut * s_i_1d(ji,jk) + rt0 ! Melting point of layer k [K] 331 332 IF( t_i_1d(ji,jk) >= ztmelts ) THEN !!! Internal melting 333 334 zEi = - q_i_1d(ji,jk) * r1_rhoic ! Specific enthalpy of layer k [J/kg, <0] 335 zdE = 0._wp ! Specific enthalpy difference (J/kg, <0) 336 ! set up at 0 since no energy is needed to melt water...(it is already melted) 337 zdeltah(ji,jk) = MIN( 0._wp , - zh_i(ji,jk) ) ! internal melting occurs when the internal temperature is above freezing 338 ! this should normally not happen, but sometimes, heat diffusion leads to this 339 zfmdt = - zdeltah(ji,jk) * rhoic ! Mass flux x time step > 0 340 341 dh_i_surf(ji) = dh_i_surf(ji) + zdeltah(ji,jk) ! Cumulate surface melt 342 343 zfmdt = - rhoic * zdeltah(ji,jk) ! Recompute mass flux [kg/m2, >0] 344 345 ! Contribution to heat flux to the ocean [W.m-2], <0 (ice enthalpy zEi is "sent" to the ocean) 346 hfx_res_1d(ji) = hfx_res_1d(ji) + zfmdt * a_i_1d(ji) * zEi * r1_rdtice 347 348 ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok) 349 sfx_res_1d(ji) = sfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice 350 351 ! Contribution to mass flux 352 wfx_res_1d(ji) = wfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice 353 354 ELSE !!! Surface melting 355 356 zEi = - q_i_1d(ji,jk) * r1_rhoic ! Specific enthalpy of layer k [J/kg, <0] 357 zEw = rcp * ( ztmelts - rt0 ) ! Specific enthalpy of resulting meltwater [J/kg, <0] 358 zdE = zEi - zEw ! Specific enthalpy difference < 0 359 360 zfmdt = - zq_su(ji) / zdE ! Mass flux to the ocean [kg/m2, >0] 361 362 zdeltah(ji,jk) = - zfmdt * r1_rhoic ! Melt of layer jk [m, <0] 363 364 zdeltah(ji,jk) = MIN( 0._wp , MAX( zdeltah(ji,jk) , - zh_i(ji,jk) ) ) ! Melt of layer jk cannot exceed the layer thickness [m, <0] 365 366 zq_su(ji) = MAX( 0._wp , zq_su(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat 367 368 dh_i_surf(ji) = dh_i_surf(ji) + zdeltah(ji,jk) ! Cumulate surface melt 369 370 zfmdt = - rhoic * zdeltah(ji,jk) ! Recompute mass flux [kg/m2, >0] 371 372 zQm = zfmdt * zEw ! Energy of the melt water sent to the ocean [J/m2, <0] 373 374 ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok) 375 sfx_sum_1d(ji) = sfx_sum_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice 376 377 ! Contribution to heat flux [W.m-2], < 0 378 hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice 379 380 ! Total heat flux used in this process [W.m-2], > 0 381 hfx_sum_1d(ji) = hfx_sum_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice 382 383 ! Contribution to mass flux 384 wfx_sum_1d(ji) = wfx_sum_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice 385 386 END IF 371 387 ! record which layers have disappeared (for bottom melting) 372 388 ! => icount=0 : no layer has vanished 373 389 ! => icount=5 : 5 layers have vanished 374 rswitch = MAX( 0._wp , SIGN( 1._wp , - ( zh_i(ji,jk) + zdeltah(ji,jk) ) ) )375 icount(ji ) = icount(ji) +NINT( rswitch )376 zh_i(ji,jk) = MAX( 0._wp , zh_i(ji,jk) + zdeltah(ji,jk) )390 rswitch = MAX( 0._wp , SIGN( 1._wp , - ( zh_i(ji,jk) + zdeltah(ji,jk) ) ) ) 391 icount(ji,jk) = NINT( rswitch ) 392 zh_i(ji,jk) = MAX( 0._wp , zh_i(ji,jk) + zdeltah(ji,jk) ) 377 393 378 394 ! update heat content (J.m-2) and layer thickness … … 405 421 ! -> need for an iterative procedure, which converges quickly 406 422 407 IF ( nn_icesal == 2 ) THEN 408 num_iter_max = 5 409 ELSE 410 num_iter_max = 1 411 ENDIF 412 413 ! Just to be sure that enthalpy at nlay_i+1 is null 414 DO ji = kideb, kiut 415 q_i_1d(ji,nlay_i+1) = 0._wp 416 END DO 423 num_iter_max = 1 424 IF( nn_icesal == 2 ) num_iter_max = 5 417 425 418 426 ! Iterative procedure … … 483 491 484 492 ! Contribution to salt flux, <0 485 sfx_bog_1d(ji) = sfx_bog_1d(ji) + s_i_new(ji) * a_i_1d(ji) * zfmdt* r1_rdtice493 sfx_bog_1d(ji) = sfx_bog_1d(ji) - rhoic * a_i_1d(ji) * dh_i_bott(ji) * s_i_new(ji) * r1_rdtice 486 494 487 495 ! Contribution to mass flux, <0 … … 500 508 DO jk = nlay_i, 1, -1 501 509 DO ji = kideb, kiut 502 IF( zf_tt(ji) > = 0._wp .AND. jk > icount(ji) ) THEN ! do not calculate where layer has already disappeared by surface melting510 IF( zf_tt(ji) > 0._wp .AND. jk > icount(ji,jk) ) THEN ! do not calculate where layer has already disappeared by surface melting 503 511 504 512 ztmelts = - tmut * s_i_1d(ji,jk) + rt0 ! Melting point of layer jk (K) … … 507 515 508 516 zEi = - q_i_1d(ji,jk) * r1_rhoic ! Specific enthalpy of melting ice (J/kg, <0) 509 510 !!zEw = rcp * ( t_i_1d(ji,jk) - rt0 ) ! Specific enthalpy of meltwater at T = t_i_1d (J/kg, <0)511 512 517 zdE = 0._wp ! Specific enthalpy difference (J/kg, <0) 513 518 ! set up at 0 since no energy is needed to melt water...(it is already melted) 514 515 zdeltah (ji,jk) = MIN( 0._wp , - zh_i(ji,jk) ) ! internal melting occurs when the internal temperature is above freezing 516 ! this should normally not happen, but sometimes, heat diffusion leads to this 519 zdeltah (ji,jk) = MIN( 0._wp , - zh_i(ji,jk) ) ! internal melting occurs when the internal temperature is above freezing 520 ! this should normally not happen, but sometimes, heat diffusion leads to this 517 521 518 522 dh_i_bott (ji) = dh_i_bott(ji) + zdeltah(ji,jk) 519 523 520 zfmdt = - zdeltah(ji,jk) * rhoic 524 zfmdt = - zdeltah(ji,jk) * rhoic ! Mass flux x time step > 0 521 525 522 526 ! Contribution to heat flux to the ocean [W.m-2], <0 (ice enthalpy zEi is "sent" to the ocean) … … 524 528 525 529 ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok) 526 sfx_res_1d(ji) = sfx_res_1d(ji) - sm_i_1d(ji) * a_i_1d(ji) * zdeltah(ji,jk) * rhoic* r1_rdtice530 sfx_res_1d(ji) = sfx_res_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice 527 531 528 532 ! Contribution to mass flux … … 535 539 ELSE !!! Basal melting 536 540 537 zEi = - q_i_1d(ji,jk) * r1_rhoic ! Specific enthalpy of melting ice (J/kg, <0) 538 539 zEw = rcp * ( ztmelts - rt0 ) ! Specific enthalpy of meltwater (J/kg, <0) 540 541 zdE = zEi - zEw ! Specific enthalpy difference (J/kg, <0) 542 543 zfmdt = - zq_bo(ji) / zdE ! Mass flux x time step (kg/m2, >0) 544 545 zdeltah(ji,jk) = - zfmdt * r1_rhoic ! Gross thickness change 546 547 zdeltah(ji,jk) = MIN( 0._wp , MAX( zdeltah(ji,jk), - zh_i(ji,jk) ) ) ! bound thickness change 541 zEi = - q_i_1d(ji,jk) * r1_rhoic ! Specific enthalpy of melting ice (J/kg, <0) 542 zEw = rcp * ( ztmelts - rt0 ) ! Specific enthalpy of meltwater (J/kg, <0) 543 zdE = zEi - zEw ! Specific enthalpy difference (J/kg, <0) 544 545 zfmdt = - zq_bo(ji) / zdE ! Mass flux x time step (kg/m2, >0) 546 547 zdeltah(ji,jk) = - zfmdt * r1_rhoic ! Gross thickness change 548 549 zdeltah(ji,jk) = MIN( 0._wp , MAX( zdeltah(ji,jk), - zh_i(ji,jk) ) ) ! bound thickness change 548 550 549 zq_bo(ji) 550 551 dh_i_bott(ji) 552 553 zfmdt 554 555 zQm 551 zq_bo(ji) = MAX( 0._wp , zq_bo(ji) - zdeltah(ji,jk) * rhoic * zdE ) ! update available heat. MAX is necessary for roundup errors 552 553 dh_i_bott(ji) = dh_i_bott(ji) + zdeltah(ji,jk) ! Update basal melt 554 555 zfmdt = - zdeltah(ji,jk) * rhoic ! Mass flux x time step > 0 556 557 zQm = zfmdt * zEw ! Heat exchanged with ocean 556 558 557 559 ! Contribution to heat flux to the ocean [W.m-2], <0 558 hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice560 hfx_thd_1d(ji) = hfx_thd_1d(ji) + zfmdt * a_i_1d(ji) * zEw * r1_rdtice 559 561 560 562 ! Contribution to salt flux (clem: using sm_i_1d and not s_i_1d(jk) is ok) 561 sfx_bom_1d(ji) = sfx_bom_1d(ji) - sm_i_1d(ji) * a_i_1d(ji) * zdeltah(ji,jk) * rhoic* r1_rdtice563 sfx_bom_1d(ji) = sfx_bom_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * sm_i_1d(ji) * r1_rdtice 562 564 563 565 ! Total heat flux used in this process [W.m-2], >0 564 hfx_bom_1d(ji) = hfx_bom_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice566 hfx_bom_1d(ji) = hfx_bom_1d(ji) - zfmdt * a_i_1d(ji) * zdE * r1_rdtice 565 567 566 568 ! Contribution to mass flux 567 wfx_bom_1d(ji) = wfx_bom_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice569 wfx_bom_1d(ji) = wfx_bom_1d(ji) - rhoic * a_i_1d(ji) * zdeltah(ji,jk) * r1_rdtice 568 570 569 571 ! update heat content (J.m-2) and layer thickness … … 595 597 zdeltah (ji,1) = - rswitch * zq_rema(ji) / MAX( q_s_1d(ji,1), epsi20 ) 596 598 zdeltah (ji,1) = MIN( 0._wp , MAX( zdeltah(ji,1) , - ht_s_1d(ji) ) ) ! bound melting 597 zdh_s_mel(ji) = zdh_s_mel(ji) + zdeltah(ji,1)598 599 dh_s_tot (ji) = dh_s_tot(ji) + zdeltah(ji,1) 599 600 ht_s_1d (ji) = ht_s_1d(ji) + zdeltah(ji,1) … … 622 623 dh_snowice(ji) = MAX( 0._wp , ( rhosn * ht_s_1d(ji) + (rhoic-rau0) * ht_i_1d(ji) ) / ( rhosn+rau0-rhoic ) ) 623 624 624 ht_i_1d(ji) 625 ht_s_1d(ji) 625 ht_i_1d(ji) = ht_i_1d(ji) + dh_snowice(ji) 626 ht_s_1d(ji) = ht_s_1d(ji) - dh_snowice(ji) 626 627 627 628 ! Salinity of snow ice … … 669 670 ! Update temperature, energy 670 671 !------------------------------------------- 671 !clem bug: we should take snow into account here672 672 DO ji = kideb, kiut 673 673 rswitch = 1.0 - MAX( 0._wp , SIGN( 1._wp , - ht_i_1d(ji) ) ) … … 688 688 WHERE( ht_i_1d == 0._wp ) a_i_1d = 0._wp 689 689 690 CALL wrk_dealloc( jpij, z h_s, zqprec, zq_su, zq_bo, zf_tt, zq_rema )690 CALL wrk_dealloc( jpij, zqprec, zq_su, zq_bo, zf_tt, zq_rema ) 691 691 CALL wrk_dealloc( jpij, zdh_s_mel, zdh_s_pre, zdh_s_sub, zqh_i, zqh_s, zq_s ) 692 CALL wrk_dealloc( jpij, nlay_i +1, zdeltah, zh_i )693 CALL wrk_dealloc( jpij, icount )692 CALL wrk_dealloc( jpij, nlay_i, zdeltah, zh_i ) 693 CALL wrk_dealloc( jpij, nlay_i, icount ) 694 694 ! 695 695 ! -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90
r5128 r5350 120 120 REAL(wp), POINTER, DIMENSION(:) :: zh_s ! snow layer thickness 121 121 REAL(wp), POINTER, DIMENSION(:) :: zfsw ! solar radiation absorbed at the surface 122 REAL(wp), POINTER, DIMENSION(:) :: zqns_ice_b ! solar radiation absorbed at the surface 122 123 REAL(wp), POINTER, DIMENSION(:) :: zf ! surface flux function 123 124 REAL(wp), POINTER, DIMENSION(:) :: dzf ! derivative of the surface flux function … … 168 169 CALL wrk_alloc( jpij, numeqmin, numeqmax ) 169 170 CALL wrk_alloc( jpij, isnow, ztsub, ztsubit, zh_i, zh_s, zfsw ) 170 CALL wrk_alloc( jpij, zf, dzf, z errit, zdifcase, zftrice, zihic, zghe )171 CALL wrk_alloc( jpij, nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart=0)172 CALL wrk_alloc( jpij, nlay_s+1, zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart=0)173 CALL wrk_alloc( jpij, 174 CALL wrk_alloc( jpij, nlay_i+3,3, ztrid )171 CALL wrk_alloc( jpij, zf, dzf, zqns_ice_b, zerrit, zdifcase, zftrice, zihic, zghe ) 172 CALL wrk_alloc( jpij,nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart=0 ) 173 CALL wrk_alloc( jpij,nlay_s+1, zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart=0 ) 174 CALL wrk_alloc( jpij,nlay_i+3, zindterm, zindtbis, zdiagbis ) 175 CALL wrk_alloc( jpij,nlay_i+3,3, ztrid ) 175 176 176 177 CALL wrk_alloc( jpij, zdq, zq_ini, zhfx_err ) … … 242 243 !------------------------------------------------------- 243 244 DO ji = kideb , kiut 244 zfsw (ji) = qsr_ice_1d(ji) * ( 1 - i0(ji) ) ! Shortwave radiation absorbed at surface 245 zftrice(ji) = qsr_ice_1d(ji) * i0(ji) ! Solar radiation transmitted below the surface layer 246 dzf (ji) = dqns_ice_1d(ji) ! derivative of incoming nonsolar flux 245 zfsw (ji) = qsr_ice_1d(ji) * ( 1 - i0(ji) ) ! Shortwave radiation absorbed at surface 246 zftrice(ji) = qsr_ice_1d(ji) * i0(ji) ! Solar radiation transmitted below the surface layer 247 dzf (ji) = dqns_ice_1d(ji) ! derivative of incoming nonsolar flux 248 zqns_ice_b(ji) = qns_ice_1d(ji) ! store previous qns_ice_1d value 247 249 END DO 248 250 … … 452 454 !------------------------------------------------------------------------------| 453 455 ! 454 IF ( .NOT. lk_cpl ) THEN !--- forced atmosphere case456 IF ( ln_it_qnsice ) THEN 455 457 DO ji = kideb , kiut 456 458 ! update of the non solar flux according to the update in T_su … … 677 679 END DO 678 680 679 DO numeq = nlay_i + nlay_s + 1, nlay_s + 2, -1681 DO numeq = nlay_i + nlay_s, nlay_s + 2, -1 680 682 DO ji = kideb , kiut 681 683 jk = numeq - nlay_s - 1 … … 757 759 CALL lim_thd_enmelt( kideb, kiut ) 758 760 761 ! --- diagnose the change in non-solar flux due to surface temperature change --- ! 762 IF ( ln_it_qnsice ) hfx_err_dif_1d(:) = hfx_err_dif_1d(:) - ( qns_ice_1d(:) - zqns_ice_b(:) ) * a_i_1d(:) 759 763 760 764 ! --- diag conservation imbalance on heat diffusion - PART 2 --- ! … … 768 772 ENDIF 769 773 hfx_err_1d(ji) = hfx_err_1d(ji) + zhfx_err(ji) * a_i_1d(ji) 774 775 ! total heat that is sent to the ocean (i.e. not used in the heat diffusion equation) 776 hfx_err_dif_1d(ji) = hfx_err_dif_1d(ji) + zhfx_err(ji) * a_i_1d(ji) 770 777 END DO 771 772 ! diagnose external surface (forced case) or bottom (forced case) from heat conservation773 IF( .NOT. lk_cpl ) THEN ! --- forced case: qns_ice and fc_su are diagnosed774 !775 DO ji = kideb, kiut776 qns_ice_1d(ji) = qns_ice_1d(ji) - zhfx_err(ji)777 fc_su (ji) = fc_su(ji) - zhfx_err(ji)778 END DO779 !780 ELSE ! --- coupled case: ocean turbulent heat flux is diagnosed781 !782 DO ji = kideb, kiut783 fhtur_1d (ji) = fhtur_1d(ji) - zhfx_err(ji)784 END DO785 !786 ENDIF787 778 788 779 !----------------------------------------- … … 797 788 & ( fc_su(ji) + i0(ji) * qsr_ice_1d(ji) - zradtr_i(ji,nlay_i) - fc_bo_i(ji) ) * a_i_1d(ji) 798 789 ENDIF 799 END DO 800 801 ! --- compute diagnostic net heat flux at the surface of the snow-ice system (W.m-2) 802 DO ji = kideb, kiut 803 ii = MOD( npb(ji) - 1, jpi ) + 1 ; ij = ( npb(ji) - 1 ) / jpi + 1 804 hfx_in (ii,ij) = hfx_in (ii,ij) + a_i_1d(ji) * ( qsr_ice_1d(ji) + qns_ice_1d(ji) ) 805 END DO 806 790 ! correction on the diagnosed heat flux due to non-convergence of the algorithm used to solve heat equation 791 hfx_dif_1d(ji) = hfx_dif_1d(ji) - zhfx_err(ji) * a_i_1d(ji) 792 END DO 807 793 ! 808 794 CALL wrk_dealloc( jpij, numeqmin, numeqmax ) 809 795 CALL wrk_dealloc( jpij, isnow, ztsub, ztsubit, zh_i, zh_s, zfsw ) 810 796 CALL wrk_dealloc( jpij, zf, dzf, zerrit, zdifcase, zftrice, zihic, zghe ) 811 CALL wrk_dealloc( jpij, nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, & 812 & ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart = 0 ) 813 CALL wrk_dealloc( jpij, nlay_s+1, zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart = 0 ) 814 CALL wrk_dealloc( jpij, nlay_i+3, zindterm, zindtbis, zdiagbis ) 815 CALL wrk_dealloc( jpij, nlay_i+3, 3, ztrid ) 797 CALL wrk_dealloc( jpij,nlay_i+1, ztcond_i, zradtr_i, zradab_i, zkappa_i, ztib, zeta_i, ztitemp, z_i, zspeche_i, kjstart = 0 ) 798 CALL wrk_dealloc( jpij,nlay_s+1, zradtr_s, zradab_s, zkappa_s, ztsb, zeta_s, ztstemp, z_s, kjstart = 0 ) 799 CALL wrk_dealloc( jpij,nlay_i+3, zindterm, zindtbis, zdiagbis ) 800 CALL wrk_dealloc( jpij,nlay_i+3,3, ztrid ) 816 801 CALL wrk_dealloc( jpij, zdq, zq_ini, zhfx_err ) 817 802 … … 834 819 DO jk = 1, nlay_i ! Sea ice energy of melting 835 820 DO ji = kideb, kiut 836 ztmelts = - tmut * s_i_1d(ji,jk) + rt0 837 rswitch = MAX( 0._wp , SIGN( 1._wp , -(t_i_1d(ji,jk) - rt0) - epsi20 ) ) 838 q_i_1d(ji,jk) = rhoic * ( cpic * ( ztmelts - t_i_1d(ji,jk) ) & 839 & + lfus * ( 1.0 - rswitch * ( ztmelts-rt0 ) / MIN( t_i_1d(ji,jk) - rt0, -epsi20 ) ) & 840 & - rcp * ( ztmelts-rt0 ) ) 821 ztmelts = - tmut * s_i_1d(ji,jk) + rt0 822 t_i_1d(ji,jk) = MIN( t_i_1d(ji,jk), ztmelts ) ! Force t_i_1d to be lower than melting point 823 ! (sometimes dif scheme produces abnormally high temperatures) 824 q_i_1d(ji,jk) = rhoic * ( cpic * ( ztmelts - t_i_1d(ji,jk) ) & 825 & + lfus * ( 1.0 - ( ztmelts-rt0 ) / ( t_i_1d(ji,jk) - rt0 ) ) & 826 & - rcp * ( ztmelts-rt0 ) ) 841 827 END DO 842 828 END DO -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90
r5134 r5350 31 31 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 32 32 USE limthd_ent 33 USE limvar 33 34 34 35 IMPLICIT NONE … … 105 106 REAL(wp), POINTER, DIMENSION(:,:) :: za_i_1d ! 1-D version of a_i 106 107 REAL(wp), POINTER, DIMENSION(:,:) :: zv_i_1d ! 1-D version of v_i 107 REAL(wp), POINTER, DIMENSION(:,:) :: zoa_i_1d ! 1-D version of oa_i108 108 REAL(wp), POINTER, DIMENSION(:,:) :: zsmv_i_1d ! 1-D version of smv_i 109 109 … … 118 118 CALL wrk_alloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice ) 119 119 CALL wrk_alloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_1d ) 120 CALL wrk_alloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, z oa_i_1d, zsmv_i_1d )121 CALL wrk_alloc( jpij,nlay_i +1,jpl, ze_i_1d )120 CALL wrk_alloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zsmv_i_1d ) 121 CALL wrk_alloc( jpij,nlay_i,jpl, ze_i_1d ) 122 122 CALL wrk_alloc( jpi,jpj, zvrel ) 123 123 124 CALL lim_var_agg(1) 125 CALL lim_var_glo2eqv 124 126 !------------------------------------------------------------------------------| 125 127 ! 2) Convert units for ice internal energy … … 289 291 CALL tab_2d_1d( nbpac, za_i_1d (1:nbpac,jl), a_i (:,:,jl), jpi, jpj, npac(1:nbpac) ) 290 292 CALL tab_2d_1d( nbpac, zv_i_1d (1:nbpac,jl), v_i (:,:,jl), jpi, jpj, npac(1:nbpac) ) 291 CALL tab_2d_1d( nbpac, zoa_i_1d (1:nbpac,jl), oa_i (:,:,jl), jpi, jpj, npac(1:nbpac) )292 293 CALL tab_2d_1d( nbpac, zsmv_i_1d(1:nbpac,jl), smv_i(:,:,jl), jpi, jpj, npac(1:nbpac) ) 293 294 DO jk = 1, nlay_i 294 295 CALL tab_2d_1d( nbpac, ze_i_1d(1:nbpac,jk,jl), e_i(:,:,jk,jl) , jpi, jpj, npac(1:nbpac) ) 295 END DO ! jk296 END DO ! jl296 END DO 297 END DO 297 298 298 299 CALL tab_2d_1d( nbpac, qlead_1d (1:nbpac) , qlead , jpi, jpj, npac(1:nbpac) ) … … 355 356 DO ji = 1, nbpac 356 357 zo_newice(ji) = 0._wp 357 END DO ! ji358 END DO 358 359 359 360 !------------------- … … 477 478 ENDDO 478 479 479 !------------480 ! Update age481 !------------482 DO jl = 1, jpl483 DO ji = 1, nbpac484 rswitch = MAX( 0._wp , SIGN( 1._wp , za_i_1d(ji,jl) - epsi20 ) ) ! 0 if no ice and 1 if yes485 zoa_i_1d(ji,jl) = za_b(ji,jl) * zoa_i_1d(ji,jl) / MAX( za_i_1d(ji,jl) , epsi20 ) * rswitch486 END DO487 END DO488 489 480 !----------------- 490 481 ! Update salinity … … 503 494 CALL tab_1d_2d( nbpac, a_i (:,:,jl), npac(1:nbpac), za_i_1d (1:nbpac,jl), jpi, jpj ) 504 495 CALL tab_1d_2d( nbpac, v_i (:,:,jl), npac(1:nbpac), zv_i_1d (1:nbpac,jl), jpi, jpj ) 505 CALL tab_1d_2d( nbpac, oa_i(:,:,jl), npac(1:nbpac), zoa_i_1d(1:nbpac,jl), jpi, jpj )506 496 CALL tab_1d_2d( nbpac, smv_i (:,:,jl), npac(1:nbpac), zsmv_i_1d(1:nbpac,jl) , jpi, jpj ) 507 497 DO jk = 1, nlay_i … … 535 525 CALL wrk_dealloc( jpij, zswinew, zv_newice, za_newice, zh_newice, ze_newice, zs_newice, zo_newice ) 536 526 CALL wrk_dealloc( jpij, zdv_res, zda_res, zat_i_1d, zv_frazb, zvrel_1d ) 537 CALL wrk_dealloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, z oa_i_1d, zsmv_i_1d )538 CALL wrk_dealloc( jpij,nlay_i +1,jpl, ze_i_1d )527 CALL wrk_dealloc( jpij,jpl, zv_b, za_b, za_i_1d, zv_i_1d, zsmv_i_1d ) 528 CALL wrk_dealloc( jpij,nlay_i,jpl, ze_i_1d ) 539 529 CALL wrk_dealloc( jpi,jpj, zvrel ) 540 530 ! -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90
r5134 r5350 80 80 IF( nn_timing == 1 ) CALL timing_start('limtrp') 81 81 82 CALL wrk_alloc( jpi,jpj, zsm, zatold, zeiold, zesold )83 CALL wrk_alloc( jpi,jpj,jpl, z0ice, z0snw, z0ai, z0es , z0smi , z0oi )84 CALL wrk_alloc( jpi,jpj,1, z0opw )85 CALL wrk_alloc( jpi,jpj,nlay_i +1,jpl, z0ei )86 CALL wrk_alloc( jpi,jpj,jpl, zhimax, zviold, zvsold, zsmvold )82 CALL wrk_alloc( jpi,jpj, zsm, zatold, zeiold, zesold ) 83 CALL wrk_alloc( jpi,jpj,jpl, z0ice, z0snw, z0ai, z0es , z0smi , z0oi ) 84 CALL wrk_alloc( jpi,jpj,1, z0opw ) 85 CALL wrk_alloc( jpi,jpj,nlay_i,jpl, z0ei ) 86 CALL wrk_alloc( jpi,jpj,jpl, zhimax, zviold, zvsold, zsmvold ) 87 87 88 88 IF( numit == nstart .AND. lwp ) THEN … … 112 112 113 113 !--- Thickness correction init. ------------------------------- 114 CALL lim_var_glo2eqv115 114 zatold(:,:) = SUM( a_i(:,:,:), dim=3 ) 115 DO jl = 1, jpl 116 DO jj = 1, jpj 117 DO ji = 1, jpi 118 rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) ) 119 ht_i (ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 120 ht_s (ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 121 END DO 122 END DO 123 END DO 116 124 !--------------------------------------------------------------------- 117 ! Record max of the surrounding ice thicknesses for correction in limupdate125 ! Record max of the surrounding ice thicknesses for correction 118 126 ! in case advection creates ice too thick. 119 127 !--------------------------------------------------------------------- … … 142 150 143 151 IF( zcfl > 0.5_wp .AND. lwp ) ncfl = ncfl + 1 144 IF( numit == nlast .AND. lwp ) THEN 145 IF( ncfl > 0 ) THEN 146 WRITE(cltmp,'(i6.1)') ncfl 147 CALL ctl_stop('STOP',TRIM(cltmp) ) 148 CALL ctl_warn( 'lim_trp: ', TRIM(cltmp), 'advective ice time-step using a split in sub-time-step ') 149 ELSE 150 WRITE(numout,*) 'lim_trp : CFL criteria for ice advection is always smaller than 1/2 ' 151 ENDIF 152 ENDIF 152 !! IF( lwp ) THEN 153 !! IF( ncfl > 0 ) THEN 154 !! WRITE(cltmp,'(i6.1)') ncfl 155 !! CALL ctl_warn( 'lim_trp: ncfl= ', TRIM(cltmp), 'advective ice time-step using a split in sub-time-step ') 156 !! ELSE 157 !! ! WRITE(numout,*) 'lim_trp : CFL criterion for ice advection is always smaller than 1/2 ' 158 !! ENDIF 159 !! ENDIF 153 160 154 161 !------------------------- … … 229 236 CALL lim_adv_x( zusnit, u_ice, 0._wp, zsm, z0smi (:,:,jl), sxsal(:,:,jl), & 230 237 & sxxsal(:,:,jl), sysal(:,:,jl), syysal(:,:,jl), sxysal(:,:,jl) ) 231 232 238 CALL lim_adv_y( zusnit, v_ice, 1._wp, zsm, z0oi (:,:,jl), sxage(:,:,jl), & !--- ice age --- 233 239 & sxxage(:,:,jl), syage(:,:,jl), syyage(:,:,jl), sxyage(:,:,jl) ) … … 346 352 !!gm & cr 347 353 354 ! --- diags --- 355 DO jj = 1, jpj 356 DO ji = 1, jpi 357 diag_trp_ei(ji,jj) = ( SUM( e_i(ji,jj,1:nlay_i,:) ) - zeiold(ji,jj) ) * r1_rdtice 358 diag_trp_es(ji,jj) = ( SUM( e_s(ji,jj,1:nlay_s,:) ) - zesold(ji,jj) ) * r1_rdtice 359 360 diag_trp_vi (ji,jj) = SUM( v_i(ji,jj,:) - zviold(ji,jj,:) ) * r1_rdtice 361 diag_trp_vs (ji,jj) = SUM( v_s(ji,jj,:) - zvsold(ji,jj,:) ) * r1_rdtice 362 diag_trp_smv(ji,jj) = SUM( smv_i(ji,jj,:) - zsmvold(ji,jj,:) ) * r1_rdtice 363 END DO 364 END DO 365 348 366 ! zap small areas 349 367 CALL lim_var_zapsmall 350 368 351 369 !--- Thickness correction in case too high -------------------------------------------------------- 352 CALL lim_var_glo2eqv353 370 DO jl = 1, jpl 354 371 DO jj = 1, jpj … … 357 374 IF ( v_i(ji,jj,jl) > 0._wp ) THEN 358 375 376 rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) ) 377 ht_i (ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 378 ht_s (ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 379 359 380 zvi = v_i (ji,jj,jl) 360 381 zvs = v_s (ji,jj,jl) … … 366 387 367 388 IF ( ( zdv > 0.0 .AND. (ht_i(ji,jj,jl)+ht_s(ji,jj,jl)) > zhimax(ji,jj,jl) .AND. zatold(ji,jj) < 0.80 ) .OR. & 368 & ( zdv <= 0.0 .AND. (ht_i(ji,jj,jl)+ht_s(ji,jj,jl)) > zhimax(ji,jj,jl) ) ) THEN 389 & ( zdv <= 0.0 .AND. (ht_i(ji,jj,jl)+ht_s(ji,jj,jl)) > zhimax(ji,jj,jl) ) ) THEN 369 390 370 391 rswitch = MAX( 0._wp, SIGN( 1._wp, zhimax(ji,jj,jl) - epsi20 ) ) … … 406 427 ENDIF 407 428 408 ! --- diags ---409 DO jj = 1, jpj410 DO ji = 1, jpi411 diag_trp_ei(ji,jj) = ( SUM( e_i(ji,jj,1:nlay_i,:) ) - zeiold(ji,jj) ) * r1_rdtice412 diag_trp_es(ji,jj) = ( SUM( e_s(ji,jj,1:nlay_s,:) ) - zesold(ji,jj) ) * r1_rdtice413 414 diag_trp_vi (ji,jj) = SUM( v_i(ji,jj,:) - zviold(ji,jj,:) ) * r1_rdtice415 diag_trp_vs (ji,jj) = SUM( v_s(ji,jj,:) - zvsold(ji,jj,:) ) * r1_rdtice416 diag_trp_smv(ji,jj) = SUM( smv_i(ji,jj,:) - zsmvold(ji,jj,:) ) * r1_rdtice417 END DO418 END DO419 420 429 ! --- agglomerate variables ----------------- 421 430 vt_i (:,:) = 0._wp … … 445 454 ENDIF 446 455 447 CALL lim_var_glo2eqv ! equivalent variables, requested for rafting448 449 456 ! ------------------------------------------------- 450 457 ! control prints … … 452 459 IF( ln_icectl ) CALL lim_prt( kt, iiceprt, jiceprt,-1, ' - ice dyn & trp - ' ) 453 460 ! 454 CALL wrk_dealloc( jpi,jpj, zsm, zatold, zeiold, zesold )455 CALL wrk_dealloc( jpi,jpj,jpl, z0ice, z0snw, z0ai, z0es , z0smi , z0oi )456 CALL wrk_dealloc( jpi,jpj,1, z0opw )457 CALL wrk_dealloc( jpi,jpj,nlay_i +1,jpl, z0ei )458 CALL wrk_dealloc( jpi,jpj,jpl, zviold, zvsold, zhimax, zsmvold )461 CALL wrk_dealloc( jpi,jpj, zsm, zatold, zeiold, zesold ) 462 CALL wrk_dealloc( jpi,jpj,jpl, z0ice, z0snw, z0ai, z0es , z0smi , z0oi ) 463 CALL wrk_dealloc( jpi,jpj,1, z0opw ) 464 CALL wrk_dealloc( jpi,jpj,nlay_i,jpl, z0ei ) 465 CALL wrk_dealloc( jpi,jpj,jpl, zviold, zvsold, zhimax, zsmvold ) 459 466 ! 460 467 IF( nn_timing == 1 ) CALL timing_stop('limtrp') -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90
- Property svn:keywords set to Id
r5134 r5350 39 39 !!---------------------------------------------------------------------- 40 40 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 41 !! $Id : limupdate.F90 3294 2012-01-28 16:44:18Z rblod$41 !! $Id$ 42 42 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 43 43 !!---------------------------------------------------------------------- … … 69 69 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 70 70 71 CALL lim_var_glo2eqv72 71 !---------------------------------------------------- 73 72 ! ice concentration should not exceed amax … … 82 81 DO ji = 1, jpi 83 82 IF( at_i(ji,jj) > rn_amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN 84 a_i(ji,jj,jl) = a_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) ) 83 a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) ) 84 oa_i(ji,jj,jl) = oa_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) ) 85 85 ENDIF 86 86 END DO … … 88 88 END DO 89 89 90 !----------------------------------------------------91 ! Rebin categories with thickness out of bounds92 !----------------------------------------------------93 IF ( jpl > 1 ) CALL lim_itd_th_reb(1, jpl)94 95 !-----------------96 ! zap small values97 !-----------------98 CALL lim_var_zapsmall99 100 90 !--------------------- 101 91 ! Ice salinity bounds … … 106 96 DO ji = 1, jpi 107 97 zsal = smv_i(ji,jj,jl) 108 smv_i(ji,jj,jl) = sm_i(ji,jj,jl) * v_i(ji,jj,jl)109 98 ! salinity stays in bounds 110 99 rswitch = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) ) … … 117 106 ENDIF 118 107 108 !---------------------------------------------------- 109 ! Rebin categories with thickness out of bounds 110 !---------------------------------------------------- 111 IF ( jpl > 1 ) CALL lim_itd_th_reb(1, jpl) 112 113 !----------------- 114 ! zap small values 115 !----------------- 116 CALL lim_var_zapsmall 117 118 ! ------------------------------------------------- 119 ! Diagnostics 120 ! ------------------------------------------------- 121 DO jl = 1, jpl 122 afx_dyn(:,:) = afx_dyn(:,:) + ( a_i(:,:,jl) - a_i_b(:,:,jl) ) * r1_rdtice 123 END DO 124 125 DO jj = 1, jpj 126 DO ji = 1, jpi 127 ! heat content variation (W.m-2) 128 diag_heat(ji,jj) = - ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) + & 129 & SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) ) & 130 & ) * r1_rdtice 131 ! salt, volume 132 diag_smvi(ji,jj) = SUM( smv_i(ji,jj,:) - smv_i_b(ji,jj,:) ) * rhoic * r1_rdtice 133 diag_vice(ji,jj) = SUM( v_i (ji,jj,:) - v_i_b (ji,jj,:) ) * rhoic * r1_rdtice 134 diag_vsnw(ji,jj) = SUM( v_s (ji,jj,:) - v_s_b (ji,jj,:) ) * rhosn * r1_rdtice 135 END DO 136 END DO 137 119 138 ! conservation test 120 139 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limupdate1', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 121 122 ! -------------------------------------------------123 ! Diagnostics124 ! -------------------------------------------------125 DO jl = 1, jpl126 afx_dyn(:,:) = afx_dyn(:,:) + ( a_i(:,:,jl) - a_i_b(:,:,jl) ) * r1_rdtice127 END DO128 129 ! heat content variation (W.m-2)130 DO jj = 1, jpj131 DO ji = 1, jpi132 diag_heat_dhc(ji,jj) = - ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) + &133 & SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) ) &134 & ) * r1_rdtice135 END DO136 END DO137 140 138 141 ! ------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90
- Property svn:keywords set to Id
r5134 r5350 41 41 !!---------------------------------------------------------------------- 42 42 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 43 !! $Id : limupdate.F90 3294 2012-01-28 16:44:18Z rblod$43 !! $Id$ 44 44 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 45 45 !!---------------------------------------------------------------------- … … 72 72 ! Constrain the thickness of the smallest category above himin 73 73 !---------------------------------------------------------------------- 74 CALL lim_var_glo2eqv75 74 DO jj = 1, jpj 76 75 DO ji = 1, jpi 76 rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,1) - epsi20 ) ) !0 if no ice and 1 if yes 77 ht_i(ji,jj,1) = v_i (ji,jj,1) / MAX( a_i(ji,jj,1) , epsi20 ) * rswitch 77 78 IF( v_i(ji,jj,1) > 0._wp .AND. ht_i(ji,jj,1) < rn_himin ) THEN 78 a_i (ji,jj,1) = a_i(ji,jj,1) * ht_i(ji,jj,1) / rn_himin 79 a_i (ji,jj,1) = a_i (ji,jj,1) * ht_i(ji,jj,1) / rn_himin 80 oa_i(ji,jj,1) = oa_i(ji,jj,1) * ht_i(ji,jj,1) / rn_himin 79 81 ENDIF 80 82 END DO … … 93 95 DO ji = 1, jpi 94 96 IF( at_i(ji,jj) > rn_amax .AND. a_i(ji,jj,jl) > 0._wp ) THEN 95 a_i(ji,jj,jl) = a_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) ) 97 a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) ) 98 oa_i(ji,jj,jl) = oa_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax / at_i(ji,jj) ) ) 96 99 ENDIF 97 100 END DO 98 101 END DO 99 102 END DO 100 101 !----------------------------------------------------102 ! Rebin categories with thickness out of bounds103 !----------------------------------------------------104 IF ( jpl > 1 ) CALL lim_itd_th_reb( 1, jpl )105 106 !-----------------107 ! zap small values108 !-----------------109 CALL lim_var_zapsmall110 103 111 104 !--------------------- … … 117 110 DO ji = 1, jpi 118 111 zsal = smv_i(ji,jj,jl) 119 smv_i(ji,jj,jl) = sm_i(ji,jj,jl) * v_i(ji,jj,jl)120 112 ! salinity stays in bounds 121 113 rswitch = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) ) … … 127 119 END DO 128 120 ENDIF 121 122 !---------------------------------------------------- 123 ! Rebin categories with thickness out of bounds 124 !---------------------------------------------------- 125 IF ( jpl > 1 ) CALL lim_itd_th_reb( 1, jpl ) 126 127 !----------------- 128 ! zap small values 129 !----------------- 130 CALL lim_var_zapsmall 129 131 130 132 !------------------------------------------------------------------------------ … … 150 152 v_ice(:,:) = v_ice(:,:) * vmask(:,:,1) 151 153 152 ! for outputs153 CALL lim_var_glo2eqv ! equivalent variables (outputs)154 CALL lim_var_agg(2) ! aggregate ice thickness categories155 156 ! conservation test157 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)158 159 154 ! ------------------------------------------------- 160 155 ! Diagnostics 161 156 ! ------------------------------------------------- 162 157 DO jl = 1, jpl 158 oa_i(:,:,jl) = oa_i(:,:,jl) + a_i(:,:,jl) * rdt_ice / rday ! ice natural aging 163 159 afx_thd(:,:) = afx_thd(:,:) + ( a_i(:,:,jl) - a_i_b(:,:,jl) ) * r1_rdtice 164 160 END DO 165 161 afx_tot = afx_thd + afx_dyn 166 162 167 ! heat content variation (W.m-2)168 163 DO jj = 1, jpj 169 164 DO ji = 1, jpi 170 diag_heat_dhc(ji,jj) = diag_heat_dhc(ji,jj) - & 171 & ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) + & 172 & SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) ) & 173 & ) * r1_rdtice 174 END DO 175 END DO 165 ! heat content variation (W.m-2) 166 diag_heat(ji,jj) = diag_heat(ji,jj) - & 167 & ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) + & 168 & SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) ) & 169 & ) * r1_rdtice 170 ! salt, volume 171 diag_smvi(ji,jj) = diag_smvi(ji,jj) + SUM( smv_i(ji,jj,:) - smv_i_b(ji,jj,:) ) * rhoic * r1_rdtice 172 diag_vice(ji,jj) = diag_vice(ji,jj) + SUM( v_i (ji,jj,:) - v_i_b (ji,jj,:) ) * rhoic * r1_rdtice 173 diag_vsnw(ji,jj) = diag_vsnw(ji,jj) + SUM( v_s (ji,jj,:) - v_s_b (ji,jj,:) ) * rhosn * r1_rdtice 174 END DO 175 END DO 176 177 ! conservation test 178 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 179 180 ! for outputs 181 CALL lim_var_glo2eqv 182 CALL lim_var_agg(2) 176 183 177 184 ! ------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90
r5134 r5350 124 124 DO ji = 1, jpi 125 125 et_s(ji,jj) = et_s(ji,jj) + e_s(ji,jj,1,jl) ! snow heat content 126 rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi 10 ) )127 smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , epsi 10 ) * rswitch ! ice salinity128 rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi 10 ) )129 ot_i(ji,jj) = ot_i(ji,jj) + oa_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi 10 ) * rswitch ! ice age126 rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi20 ) ) 127 smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , epsi20 ) * rswitch ! ice salinity 128 rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi20 ) ) 129 ot_i(ji,jj) = ot_i(ji,jj) + oa_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi20 ) * rswitch ! ice age 130 130 END DO 131 131 END DO … … 161 161 DO jj = 1, jpj 162 162 DO ji = 1, jpi 163 rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi 10 ) ) !0 if no ice and 1 if yes164 ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi 10 ) * rswitch165 ht_s(ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi 10 ) * rswitch166 o_i(ji,jj,jl) = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi 10 ) * rswitch163 rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) ) !0 if no ice and 1 if yes 164 ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 165 ht_s(ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 166 o_i(ji,jj,jl) = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch 167 167 END DO 168 168 END DO … … 173 173 DO jj = 1, jpj 174 174 DO ji = 1, jpi 175 rswitch = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) - epsi10 ) ) !0 if no ice and 1 if yes 176 sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX( v_i(ji,jj,jl) , epsi10 ) * rswitch 175 rswitch = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) - epsi20 ) ) !0 if no ice and 1 if yes 176 sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX( v_i(ji,jj,jl) , epsi20 ) * rswitch 177 ! ! bounding salinity 178 sm_i(ji,jj,jl) = MAX( sm_i(ji,jj,jl), rn_simin ) 177 179 END DO 178 180 END DO … … 199 201 zdiscrim = SQRT( MAX(zbbb*zbbb - 4._wp*zaaa*zccc , 0._wp) ) 200 202 t_i(ji,jj,jk,jl) = rt0 + rswitch *( - zbbb - zdiscrim ) / ( 2.0 *zaaa ) 201 t_i(ji,jj,jk,jl) = MIN( rt0, MAX( 173.15_wp, t_i(ji,jj,jk,jl) ) ) ! 100-rt0 < t_i < rt0203 t_i(ji,jj,jk,jl) = MIN( ztmelts, MAX( rt0 - 100._wp, t_i(ji,jj,jk,jl) ) ) ! -100 < t_i < ztmelts 202 204 END DO 203 205 END DO … … 219 221 ! 220 222 t_s(ji,jj,jk,jl) = rt0 + rswitch * ( - zfac1 * zq_s + zfac2 ) 221 t_s(ji,jj,jk,jl) = MIN( rt0, MAX( 173.15, t_s(ji,jj,jk,jl) ) ) ! 100-rt0 < t_i< rt0223 t_s(ji,jj,jk,jl) = MIN( rt0, MAX( rt0 - 100._wp , t_s(ji,jj,jk,jl) ) ) ! -100 < t_s < rt0 222 224 END DO 223 225 END DO … … 228 230 ! Mean temperature 229 231 !------------------- 232 vt_i (:,:) = 0._wp 233 DO jl = 1, jpl 234 vt_i(:,:) = vt_i(:,:) + v_i(:,:,jl) 235 END DO 236 230 237 tm_i(:,:) = 0._wp 231 238 DO jl = 1, jpl … … 234 241 DO ji = 1, jpi 235 242 rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) ) 236 tm_i(ji,jj) = tm_i(ji,jj) + rswitch * t_i(ji,jj,jk,jl) * v_i(ji,jj,jl) & 237 & / ( REAL(nlay_i,wp) * MAX( vt_i(ji,jj) , epsi10 ) ) 238 END DO 239 END DO 240 END DO 241 END DO 243 tm_i(ji,jj) = tm_i(ji,jj) + r1_nlay_i * rswitch * ( t_i(ji,jj,jk,jl) - rt0 ) * v_i(ji,jj,jl) & 244 & / MAX( vt_i(ji,jj) , epsi10 ) 245 END DO 246 END DO 247 END DO 248 END DO 249 tm_i = tm_i + rt0 242 250 ! 243 251 END SUBROUTINE lim_var_glo2eqv … … 258 266 v_s(:,:,:) = ht_s(:,:,:) * a_i(:,:,:) 259 267 smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:) 260 oa_i (:,:,:) = o_i (:,:,:) * a_i(:,:,:)261 268 ! 262 269 END SUBROUTINE lim_var_eqv2glo … … 305 312 DO jj = 1, jpj 306 313 DO ji = 1, jpi 307 z_slope_s(ji,jj,jl) = 2._wp * sm_i(ji,jj,jl) / MAX( epsi10 , ht_i(ji,jj,jl) ) 314 rswitch = MAX( 0._wp , SIGN( 1._wp , ht_i(ji,jj,jl) - epsi20 ) ) 315 z_slope_s(ji,jj,jl) = rswitch * 2._wp * sm_i(ji,jj,jl) / MAX( epsi20 , ht_i(ji,jj,jl) ) 308 316 END DO 309 317 END DO … … 339 347 ! ! weighting the profile 340 348 s_i(ji,jj,jk,jl) = zalpha(ji,jj,jl) * zs_zero + ( 1._wp - zalpha(ji,jj,jl) ) * sm_i(ji,jj,jl) 349 ! ! bounding salinity 350 s_i(ji,jj,jk,jl) = MIN( rn_simax, MAX( s_i(ji,jj,jk,jl), rn_simin ) ) 341 351 END DO 342 352 END DO … … 379 389 380 390 ! Mean sea ice temperature 391 vt_i (:,:) = 0._wp 392 DO jl = 1, jpl 393 vt_i(:,:) = vt_i(:,:) + v_i(:,:,jl) 394 END DO 395 381 396 tm_i(:,:) = 0._wp 382 397 DO jl = 1, jpl … … 385 400 DO ji = 1, jpi 386 401 rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) ) 387 tm_i(ji,jj) = tm_i(ji,jj) + rswitch * t_i(ji,jj,jk,jl) * v_i(ji,jj,jl) & 388 & * r1_nlay_i / MAX( vt_i(ji,jj) , epsi10 ) 389 END DO 390 END DO 391 END DO 392 END DO 402 tm_i(ji,jj) = tm_i(ji,jj) + r1_nlay_i * rswitch * ( t_i(ji,jj,jk,jl) - rt0 ) * v_i(ji,jj,jl) & 403 & / MAX( vt_i(ji,jj) , epsi10 ) 404 END DO 405 END DO 406 END DO 407 END DO 408 tm_i = tm_i + rt0 393 409 394 410 END SUBROUTINE lim_var_icetm … … 409 425 !!------------------------------------------------------------------ 410 426 ! 427 vt_i (:,:) = 0._wp 428 DO jl = 1, jpl 429 vt_i(:,:) = vt_i(:,:) + v_i(:,:,jl) 430 END DO 431 411 432 bv_i(:,:) = 0._wp 412 433 DO jl = 1, jpl … … 417 438 zbvi = - rswitch * tmut * s_i(ji,jj,jk,jl) / MIN( t_i(ji,jj,jk,jl) - rt0, - epsi10 ) & 418 439 & * v_i(ji,jj,jl) * r1_nlay_i 419 rswitch = ( 1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi 10 ) ) )420 bv_i(ji,jj) = bv_i(ji,jj) + rswitch * zbvi / MAX( vt_i(ji,jj) , epsi 10 )440 rswitch = ( 1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi20 ) ) ) 441 bv_i(ji,jj) = bv_i(ji,jj) + rswitch * zbvi / MAX( vt_i(ji,jj) , epsi20 ) 421 442 END DO 422 443 END DO … … 460 481 ! 461 482 DO ji = kideb, kiut ! Slope of the linear profile zs_zero 462 z_slope_s(ji) = 2._wp * sm_i_1d(ji) / MAX( epsi10 , ht_i_1d(ji) ) 483 rswitch = MAX( 0._wp , SIGN( 1._wp , ht_i_1d(ji) - epsi20 ) ) 484 z_slope_s(ji) = rswitch * 2._wp * sm_i_1d(ji) / MAX( epsi20 , ht_i_1d(ji) ) 463 485 END DO 464 486 … … 484 506 ! weighting the profile 485 507 s_i_1d(ji,jk) = zalpha * zs_zero + ( 1._wp - zalpha ) * sm_i_1d(ji) 508 ! bounding salinity 509 s_i_1d(ji,jk) = MIN( rn_simax, MAX( s_i_1d(ji,jk), rn_simin ) ) 486 510 END DO 487 511 END DO … … 537 561 rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi10 ) ) 538 562 rswitch = MAX( 0._wp , SIGN( 1._wp, at_i(ji,jj ) - epsi10 ) ) * rswitch 563 rswitch = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) - epsi10 ) ) * rswitch 564 rswitch = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) * rswitch & 565 & / MAX( a_i(ji,jj,jl), epsi10 ) - epsi10 ) ) * rswitch 539 566 zei = e_i(ji,jj,jk,jl) 540 567 e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * rswitch … … 550 577 rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi10 ) ) 551 578 rswitch = MAX( 0._wp , SIGN( 1._wp, at_i(ji,jj ) - epsi10 ) ) * rswitch 552 579 rswitch = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) - epsi10 ) ) * rswitch 580 rswitch = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) * rswitch & 581 & / MAX( a_i(ji,jj,jl), epsi10 ) - epsi10 ) ) * rswitch 553 582 zsal = smv_i(ji,jj, jl) 554 583 zvi = v_i (ji,jj, jl) -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90
r5123 r5350 72 72 ! Mean category values 73 73 !----------------------------- 74 z1_365 = 1._wp / 365._wp 74 75 75 76 CALL lim_var_icetm ! mean sea ice temperature … … 112 113 CALL lbc_lnk( z2da, 'T', -1. ) 113 114 CALL lbc_lnk( z2db, 'T', -1. ) 114 CALL iom_put( "uice_ipa" , z2da 115 CALL iom_put( "vice_ipa" , z2db 115 CALL iom_put( "uice_ipa" , z2da ) ! ice velocity u component 116 CALL iom_put( "vice_ipa" , z2db ) ! ice velocity v component 116 117 DO jj = 1, jpj 117 118 DO ji = 1, jpi … … 119 120 END DO 120 121 END DO 121 CALL iom_put( "icevel" , z2d 122 CALL iom_put( "icevel" , z2d ) ! ice velocity module 122 123 ENDIF 123 124 ! … … 127 128 DO jj = 1, jpj 128 129 DO ji = 1, jpi 129 z2d(ji,jj) = z2d(ji,jj) + zswi(ji,jj) * oa_i(ji,jj,jl) 130 rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.1 ) ) 131 z2d(ji,jj) = z2d(ji,jj) + rswitch * oa_i(ji,jj,jl) / MAX( at_i(ji,jj), 0.1 ) 130 132 END DO 131 133 END DO 132 134 END DO 133 z1_365 = 1._wp / 365._wp 134 CALL iom_put( "miceage" , z2d * z1_365 ) ! mean ice age 135 CALL iom_put( "miceage" , z2d * z1_365 ) ! mean ice age 135 136 ENDIF 136 137 … … 141 142 END DO 142 143 END DO 143 CALL iom_put( "micet" , z2d 144 CALL iom_put( "micet" , z2d ) ! mean ice temperature 144 145 ENDIF 145 146 ! … … 153 154 END DO 154 155 END DO 155 CALL iom_put( "icest" , z2d 156 CALL iom_put( "icest" , z2d ) ! ice surface temperature 156 157 ENDIF 157 158 … … 163 164 END DO 164 165 END DO 165 CALL iom_put( "icecolf" , z2d 166 CALL iom_put( "icecolf" , z2d ) ! frazil ice collection thickness 166 167 ENDIF 167 168 … … 232 233 CALL iom_put ('hfxopw' , hfx_opw(:,:) ) ! 233 234 CALL iom_put ('hfxtur' , fhtur(:,:) * at_i(:,:) ) ! turbulent heat flux at ice base 234 CALL iom_put ('hfxdhc' , diag_heat _dhc(:,:)) ! Heat content variation in snow and ice235 CALL iom_put ('hfxdhc' , diag_heat(:,:) ) ! Heat content variation in snow and ice 235 236 CALL iom_put ('hfxspr' , hfx_spr(:,:) ) ! Heat content of snow precip 236 237 … … 248 249 DO jj = 1, jpj 249 250 DO ji = 1, jpi 250 rswitch = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) ) 251 zoi(ji,jj,jl) = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi06 ) * rswitch 251 rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.1 ) ) 252 rswitch = rswitch * MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - 0.1 ) ) 253 zoi(ji,jj,jl) = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , 0.1 ) * rswitch 252 254 END DO 253 255 END DO 254 256 END DO 255 CALL iom_put( "iceage_cat" , zoi) ! ice age for categories257 CALL iom_put( "iceage_cat" , zoi * z1_365 ) ! ice age for categories 256 258 ENDIF 257 259 … … 264 266 DO ji = 1, jpi 265 267 rswitch = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) ) 266 zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0 *&268 zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0 * & 267 269 ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rt0 ), - epsi06 ) ) * & 268 270 rswitch * r1_nlay_i … … 271 273 END DO 272 274 END DO 273 CALL iom_put( "brinevol_cat" , zei 275 CALL iom_put( "brinevol_cat" , zei ) ! brine volume for categories 274 276 ENDIF 275 277 -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90
r5123 r5350 20 20 ! !!! ** ice-thermo namelist (namicethd) ** 21 21 REAL(wp), PUBLIC :: rn_himin !: minimum ice thickness 22 REAL(wp), PUBLIC :: parsub !: switch for snow sublimation or not23 22 REAL(wp), PUBLIC :: rn_maxfrazb !: maximum portion of frazil ice collecting at the ice bottom 24 23 REAL(wp), PUBLIC :: rn_vfrazb !: threshold drift speed for collection of bottom frazil ice … … 55 54 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_err_1d 56 55 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_err_rem_1d 56 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_err_dif_1d 57 57 58 58 ! heat flux associated with ice-atmosphere mass exchange … … 139 139 !!---------------------------------------------------------------------! 140 140 141 ALLOCATE( npb (jpij) , nplm (jpij) , npac (jpij), & 142 ! ! 143 & qlead_1d (jpij) , ftr_ice_1d (jpij) , & 144 & qsr_ice_1d (jpij) , & 145 & fr1_i0_1d(jpij) , fr2_i0_1d(jpij) , qns_ice_1d(jpij) , & 146 & t_bo_1d (jpij) , & 147 & hfx_sum_1d(jpij) , hfx_bom_1d(jpij) ,hfx_bog_1d(jpij) , & 148 & hfx_dif_1d(jpij) ,hfx_opw_1d(jpij) , & 149 & hfx_thd_1d(jpij) , hfx_spr_1d(jpij) , & 150 & hfx_snw_1d(jpij) , hfx_sub_1d(jpij) , hfx_err_1d(jpij) , & 151 & hfx_res_1d(jpij) , hfx_err_rem_1d(jpij), STAT=ierr(1) ) 141 ALLOCATE( npb (jpij) , nplm (jpij) , npac (jpij) , & 142 & qlead_1d (jpij) , ftr_ice_1d(jpij) , qsr_ice_1d (jpij) , & 143 & fr1_i0_1d(jpij) , fr2_i0_1d (jpij) , qns_ice_1d(jpij) , & 144 & t_bo_1d (jpij) , & 145 & hfx_sum_1d(jpij) , hfx_bom_1d(jpij) ,hfx_bog_1d(jpij) , & 146 & hfx_dif_1d(jpij) , hfx_opw_1d(jpij) , & 147 & hfx_thd_1d(jpij) , hfx_spr_1d(jpij) , & 148 & hfx_snw_1d(jpij) , hfx_sub_1d(jpij) , hfx_err_1d(jpij) , & 149 & hfx_res_1d(jpij) , hfx_err_rem_1d(jpij) , hfx_err_dif_1d(jpij) , STAT=ierr(1) ) 152 150 ! 153 ALLOCATE( sprecip_1d (jpij) , frld_1d (jpij) , at_i_1d (jpij) , & 154 & fhtur_1d (jpij) , wfx_snw_1d (jpij) , wfx_spr_1d (jpij) , & 155 & fhld_1d (jpij) , wfx_sub_1d (jpij) , wfx_bog_1d(jpij) , wfx_bom_1d(jpij) , & 156 & wfx_sum_1d(jpij) , wfx_sni_1d (jpij) , wfx_opw_1d (jpij) , wfx_res_1d (jpij) , & 157 & dqns_ice_1d(jpij) , qla_ice_1d (jpij) , dqla_ice_1d(jpij) , & 158 & tatm_ice_1d(jpij) , & 159 & i0 (jpij) , & 160 & sfx_bri_1d (jpij) , sfx_bog_1d (jpij) , sfx_bom_1d (jpij) ,sfx_sum_1d (jpij) , & 161 & sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , sfx_res_1d (jpij) , & 162 & dsm_i_fl_1d(jpij) , dsm_i_gd_1d(jpij) , dsm_i_se_1d(jpij) , & 151 ALLOCATE( sprecip_1d (jpij) , frld_1d (jpij) , at_i_1d (jpij) , & 152 & fhtur_1d (jpij) , wfx_snw_1d (jpij) , wfx_spr_1d (jpij) , & 153 & fhld_1d (jpij) , wfx_sub_1d (jpij) , wfx_bog_1d (jpij) , wfx_bom_1d(jpij) , & 154 & wfx_sum_1d(jpij) , wfx_sni_1d (jpij) , wfx_opw_1d (jpij) , wfx_res_1d(jpij) , & 155 & dqns_ice_1d(jpij) , qla_ice_1d (jpij) , dqla_ice_1d(jpij) , & 156 & tatm_ice_1d(jpij) , i0 (jpij) , & 157 & sfx_bri_1d (jpij) , sfx_bog_1d (jpij) , sfx_bom_1d (jpij) , sfx_sum_1d (jpij), & 158 & sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , sfx_res_1d (jpij) , & 159 & dsm_i_fl_1d(jpij) , dsm_i_gd_1d(jpij) , dsm_i_se_1d(jpij) , & 163 160 & dsm_i_si_1d(jpij) , hicol_1d (jpij) , STAT=ierr(2) ) 164 161 ! 165 ALLOCATE( t_su_1d (jpij) , a_i_1d (jpij) , ht_i_1d(jpij) , &166 & ht_s_1d 162 ALLOCATE( t_su_1d (jpij) , a_i_1d (jpij) , ht_i_1d (jpij) , & 163 & ht_s_1d (jpij) , fc_su (jpij) , fc_bo_i (jpij) , & 167 164 & dh_s_tot (jpij) , dh_i_surf(jpij) , dh_i_bott(jpij) , & 168 & dh_snowice(jpij) , & 169 & sm_i_1d (jpij) , s_i_new (jpij) , & 170 & t_s_1d(jpij,nlay_s), & 171 & t_i_1d(jpij,nlay_i+1), s_i_1d(jpij,nlay_i+1) , & 172 & q_i_1d(jpij,nlay_i+1), q_s_1d(jpij,nlay_i+1) , & 165 & dh_snowice(jpij) , sm_i_1d (jpij) , s_i_new (jpij) , & 166 & t_s_1d(jpij,nlay_s) , t_i_1d(jpij,nlay_i) , s_i_1d(jpij,nlay_i) , & 167 & q_i_1d(jpij,nlay_i+1) , q_s_1d(jpij,nlay_s) , & 173 168 & qh_i_old(jpij,0:nlay_i+1), h_i_old(jpij,0:nlay_i+1) , STAT=ierr(3)) 174 169 ! -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OFF_SRC/domain.F90
r5347 r5350 116 116 USE ioipsl 117 117 INTEGER :: ios ! Local integer output status for namelist read 118 NAMELIST/namrun/ nn_no , cn_exp , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl , & 119 & nn_it000, nn_itend , nn_date0 , nn_leapy , nn_istate , nn_stock , & 118 NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list, & 119 & nn_no , cn_exp , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl, & 120 & nn_it000, nn_itend , nn_date0 , nn_leapy , nn_istate , nn_stock , & 120 121 & nn_write, ln_dimgnnn, ln_mskland , ln_cfmeta , ln_clobber, nn_chunksz, nn_euler 121 122 NAMELIST/namdom/ nn_bathy , rn_bathy, rn_e3zps_min, rn_e3zps_rat, nn_msh , rn_hmin, & … … 172 173 ninist = nn_istate 173 174 nstock = nn_stock 175 nstocklist = nn_stocklist 174 176 nwrite = nn_write 175 177 -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90
- Property svn:keywords set to Id
r5120 r5350 62 62 !!---------------------------------------------------------------------- 63 63 !! NEMO/OFF 3.3 , NEMO Consortium (2010) 64 !! $Id : nemogcm.F90 2528 2010-12-27 17:33:53Z rblod$64 !! $Id$ 65 65 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 66 66 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OOO_SRC/dtadyn.F90
- Property svn:keywords set to Id
-
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OOO_SRC/obs_fbm.F90
- Property svn:keywords set to Id
-
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OOO_SRC/ooo_data.F90
- Property svn:keywords set to Id
r4132 r5350 40 40 CHARACTER(len=128) :: & 41 41 & alt_file !: altimeter file 42 !! $Id$ 42 43 CONTAINS 43 44 SUBROUTINE ooo_data_init( ld_cl4 ) -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OOO_SRC/ooo_intp.F90
- Property svn:keywords set to Id
r4120 r5350 16 16 PUBLIC ooo_interp 17 17 18 !! $Id$ 18 19 CONTAINS 19 20 -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OOO_SRC/ooo_read.F90
- Property svn:keywords set to Id
r4117 r5350 22 22 PUBLIC ooo_rea_dri 23 23 24 !! $Id$ 24 25 CONTAINS 25 26 SUBROUTINE ooo_rea_dri(kfile) -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OOO_SRC/ooo_utils.F90
- Property svn:keywords set to Id
r4111 r5350 10 10 REAL(kind=dp), PARAMETER :: obfilldbl=99999. 11 11 12 !! $Id$ 12 13 CONTAINS 13 14 -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OOO_SRC/ooo_write.F90
- Property svn:keywords set to Id
r4110 r5350 29 29 END INTERFACE 30 30 31 !! $Id$ 31 32 CONTAINS 32 33 -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90
- Property svn:keywords set to Id
r4990 r5350 57 57 !!---------------------------------------------------------------------- 58 58 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 59 !! $Id :$59 !! $Id$ 60 60 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 61 61 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90
- Property svn:keywords set to Id
r4999 r5350 36 36 !!---------------------------------------------------------------------- 37 37 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 38 !! $Id : bdydyn.F90 2528 2010-12-27 17:33:53Z rblod$38 !! $Id$ 39 39 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 40 40 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90
- Property svn:keywords set to Id
r4354 r5350 33 33 !!---------------------------------------------------------------------- 34 34 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 35 !! $Id : bdydyn.F90 2528 2010-12-27 17:33:53Z rblod$35 !! $Id$ 36 36 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 37 37 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90
- Property svn:keywords set to Id
r5123 r5350 28 28 USE ice ! LIM_3 ice variables 29 29 USE dom_ice ! sea-ice domain 30 USE limvar 30 31 #endif 31 32 USE par_oce ! ocean parameters … … 41 42 PRIVATE 42 43 43 PUBLIC bdy_ice_lim ! routine called in sbcmod44 PUBLIC bdy_ice_lim ! routine called in sbcmod 44 45 PUBLIC bdy_ice_lim_dyn ! routine called in limrhg 45 46 46 47 !!---------------------------------------------------------------------- 47 48 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 48 !! $Id : bdyice.F90 2715 2011-03-30 15:58:35Z rblod$49 !! $Id$ 49 50 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 50 51 !!---------------------------------------------------------------------- … … 61 62 INTEGER :: ib_bdy ! Loop index 62 63 64 #if defined key_lim3 65 CALL lim_var_glo2eqv 66 #endif 67 63 68 DO ib_bdy=1, nb_bdy 64 69 … … 73 78 74 79 END DO 80 81 #if defined key_lim3 82 CALL lim_var_zapsmall 83 CALL lim_var_agg(1) 84 #endif 75 85 76 86 END SUBROUTINE bdy_ice_lim … … 89 99 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 90 100 INTEGER, INTENT(in) :: kt ! main time-step counter 91 INTEGER, INTENT(in) :: ib_bdy ! BDY set index !!101 INTEGER, INTENT(in) :: ib_bdy ! BDY set index 92 102 93 103 INTEGER :: jpbound ! 0 = incoming ice … … 169 179 jpbound = 0; ii = ji; ij = jj; 170 180 171 IF ( u_ice(ji+1,jj ) < 0. .AND. umask(ji-1,jj ,1) == 0. ) jpbound = 1; ii = ji+1; ij = jj 172 IF ( u_ice(ji-1,jj ) > 0. .AND. umask(ji+1,jj ,1) == 0. ) jpbound = 1; ii = ji-1; ij = jj 173 IF ( v_ice(ji ,jj+1) < 0. .AND. vmask(ji ,jj-1,1) == 0. ) jpbound = 1; ii = ji ; ij = jj+1 174 IF ( v_ice(ji ,jj-1) > 0. .AND. vmask(ji ,jj+1,1) == 0. ) jpbound = 1; ii = ji ; ij = jj-1 175 176 rswitch = 1.0 - MAX( 0.0_wp , SIGN ( 1.0_wp , - at_i(ii,ij) + 0.01 ) ) ! 0 if no ice 181 IF( u_ice(ji+1,jj ) < 0. .AND. umask(ji-1,jj ,1) == 0. ) jpbound = 1; ii = ji+1; ij = jj 182 IF( u_ice(ji-1,jj ) > 0. .AND. umask(ji+1,jj ,1) == 0. ) jpbound = 1; ii = ji-1; ij = jj 183 IF( v_ice(ji ,jj+1) < 0. .AND. vmask(ji ,jj-1,1) == 0. ) jpbound = 1; ii = ji ; ij = jj+1 184 IF( v_ice(ji ,jj-1) > 0. .AND. vmask(ji ,jj+1,1) == 0. ) jpbound = 1; ii = ji ; ij = jj-1 185 186 IF( nn_ice_lim_dta(ib_bdy) == 0 ) jpbound = 0; ii = ji; ij = jj ! case ice boundaries = initial conditions 187 ! do not make state variables dependent on velocity 188 189 190 rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ii,ij) - 0.01 ) ) ! 0 if no ice 177 191 178 192 ! concentration and thickness … … 190 204 191 205 ! Ice salinity, age, temperature 192 sm_i(ji,jj,jl) = rswitch * rn_ice_sal(ib_bdy) + ( 1.0 - rswitch ) * s_i_min193 o _i(ji,jj,jl) = rswitch * rn_ice_age(ib_bdy) + ( 1.0 - rswitch)206 sm_i(ji,jj,jl) = rswitch * rn_ice_sal(ib_bdy) + ( 1.0 - rswitch ) * rn_simin 207 oa_i(ji,jj,jl) = rswitch * rn_ice_age(ib_bdy) * a_i(ji,jj,jl) 194 208 t_su(ji,jj,jl) = rswitch * rn_ice_tem(ib_bdy) + ( 1.0 - rswitch ) * rn_ice_tem(ib_bdy) 195 209 DO jk = 1, nlay_s … … 198 212 DO jk = 1, nlay_i 199 213 t_i(ji,jj,jk,jl) = rswitch * rn_ice_tem(ib_bdy) + ( 1.0 - rswitch ) * rt0 200 s_i(ji,jj,jk,jl) = rswitch * rn_ice_sal(ib_bdy) + ( 1.0 - rswitch ) * s_i_min214 s_i(ji,jj,jk,jl) = rswitch * rn_ice_sal(ib_bdy) + ( 1.0 - rswitch ) * rn_simin 201 215 END DO 202 216 … … 204 218 205 219 ! Ice salinity, age, temperature 206 sm_i(ji,jj,jl) = rswitch * sm_i(ii,ij,jl) + ( 1.0 - rswitch ) * s_i_min207 o _i(ji,jj,jl) = rswitch * o_i(ii,ij,jl) + ( 1.0 - rswitch)220 sm_i(ji,jj,jl) = rswitch * sm_i(ii,ij,jl) + ( 1.0 - rswitch ) * rn_simin 221 oa_i(ji,jj,jl) = rswitch * oa_i(ii,ij,jl) 208 222 t_su(ji,jj,jl) = rswitch * t_su(ii,ij,jl) + ( 1.0 - rswitch ) * rt0 209 223 DO jk = 1, nlay_s … … 212 226 DO jk = 1, nlay_i 213 227 t_i(ji,jj,jk,jl) = rswitch * t_i(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rt0 214 s_i(ji,jj,jk,jl) = rswitch * s_i(ii,ij,jk,jl) + ( 1.0 - rswitch ) * s_i_min228 s_i(ji,jj,jk,jl) = rswitch * s_i(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rn_simin 215 229 END DO 216 230 … … 218 232 219 233 ! if salinity is constant, then overwrite rn_ice_sal 220 IF( n um_sal == 1 ) THEN221 sm_i(ji,jj,jl) = bulk_sal222 s_i (ji,jj,:,jl) = bulk_sal234 IF( nn_icesal == 1 ) THEN 235 sm_i(ji,jj,jl) = rn_icesal 236 s_i (ji,jj,:,jl) = rn_icesal 223 237 ENDIF 224 238 225 239 ! contents 226 240 smv_i(ji,jj,jl) = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) 227 oa_i(ji,jj,jl) = o_i(ji,jj,jl) * a_i(ji,jj,jl)228 241 DO jk = 1, nlay_s 229 242 ! Snow energy of melting … … 254 267 CALL lbc_bdy_lnk( sm_i(:,:,jl), 'T', 1., ib_bdy ) 255 268 CALL lbc_bdy_lnk( oa_i(:,:,jl), 'T', 1., ib_bdy ) 256 CALL lbc_bdy_lnk( o_i(:,:,jl), 'T', 1., ib_bdy )257 269 CALL lbc_bdy_lnk( t_su(:,:,jl), 'T', 1., ib_bdy ) 258 270 DO jk = 1, nlay_s … … 286 298 !! 287 299 CHARACTER(len=1), INTENT(in) :: cd_type ! nature of velocity grid-points 288 INTEGER :: jb, jgrd ! dummy loop indices300 INTEGER :: jb, jgrd ! dummy loop indices 289 301 INTEGER :: ji, jj ! local scalar 290 INTEGER :: ib_bdy ! Loop index302 INTEGER :: ib_bdy ! Loop index 291 303 REAL(wp) :: zmsk1, zmsk2, zflag 292 304 !!------------------------------------------------------------------------------ … … 304 316 CASE('frs') 305 317 306 318 IF( nn_ice_lim_dta(ib_bdy) == 0 ) CYCLE ! case ice boundaries = initial conditions 319 ! do not change ice velocity (it is only computed by rheology) 320 307 321 SELECT CASE ( cd_type ) 308 322 309 323 CASE ( 'U' ) 310 324 … … 321 335 322 336 ! u_ice = u_ice of the adjacent grid point except if this grid point is ice-free (then u_ice = u_oce) 323 u_ice (ji,jj) = u_ice(ji+1,jj) * 0.5 * ABS( zflag + 1._wp ) * zmsk1 + &324 & u_ice(ji-1,jj) * 0.5 * ABS( zflag - 1._wp ) * zmsk2 + &337 u_ice (ji,jj) = u_ice(ji+1,jj) * 0.5_wp * ABS( zflag + 1._wp ) * zmsk1 + & 338 & u_ice(ji-1,jj) * 0.5_wp * ABS( zflag - 1._wp ) * zmsk2 + & 325 339 & u_oce(ji ,jj) * ( 1._wp - MIN( 1._wp, zmsk1 + zmsk2 ) ) 326 340 ELSE ! everywhere else … … 329 343 ENDIF 330 344 ! mask ice velocities 331 rswitch = 1.0 - MAX( 0.0_wp , SIGN ( 1.0_wp , - at_i(ji,jj) + 0.01) ) ! 0 if no ice345 rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ji,jj) - 0.01_wp ) ) ! 0 if no ice 332 346 u_ice(ji,jj) = rswitch * u_ice(ji,jj) 333 347 334 348 ENDDO 335 349 336 350 CALL lbc_bdy_lnk( u_ice(:,:), 'U', -1., ib_bdy ) 337 351 … … 350 364 351 365 ! u_ice = u_ice of the adjacent grid point except if this grid point is ice-free (then u_ice = u_oce) 352 v_ice (ji,jj) = v_ice(ji,jj+1) * 0.5 * ABS( zflag + 1._wp ) * zmsk1 + &353 & v_ice(ji,jj-1) * 0.5 * ABS( zflag - 1._wp ) * zmsk2 + &366 v_ice (ji,jj) = v_ice(ji,jj+1) * 0.5_wp * ABS( zflag + 1._wp ) * zmsk1 + & 367 & v_ice(ji,jj-1) * 0.5_wp * ABS( zflag - 1._wp ) * zmsk2 + & 354 368 & v_oce(ji,jj ) * ( 1._wp - MIN( 1._wp, zmsk1 + zmsk2 ) ) 355 369 ELSE ! everywhere else … … 358 372 ENDIF 359 373 ! mask ice velocities 360 rswitch = 1.0 - MAX( 0.0_wp , SIGN ( 1.0_wp , - at_i(ji,jj) +0.01 ) ) ! 0 if no ice374 rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ji,jj) - 0.01 ) ) ! 0 if no ice 361 375 v_ice(ji,jj) = rswitch * v_ice(ji,jj) 362 376 … … 364 378 365 379 CALL lbc_bdy_lnk( v_ice(:,:), 'V', -1., ib_bdy ) 366 380 367 381 END SELECT 368 382 -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/BDY/bdylib.F90
- Property svn:keywords set to Id
r4292 r5350 29 29 !!---------------------------------------------------------------------- 30 30 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 31 !! $Id : bdydyn.F90 2528 2010-12-27 17:33:53Z rblod$31 !! $Id$ 32 32 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 33 33 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/C1D/c1d.F90
- Property svn:keywords set to Id
r4667 r5350 31 31 !!---------------------------------------------------------------------- 32 32 !! NEMO/C1D 3.3 , NEMO Consortium (2010) 33 !! $Id : c1d.F90 2382 2010-11-13 13:08:12Z gm$33 !! $Id$ 34 34 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 35 35 !!====================================================================== -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/C1D/domc1d.F90
- Property svn:keywords set to Id
r4667 r5350 26 26 !!---------------------------------------------------------------------- 27 27 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 28 !! $Id : domc1d.F90 3851 2013-04-30 10:30:51Z hadcv$28 !! $Id$ 29 29 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 30 30 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/C1D/dtauvd.F90
- Property svn:keywords set to Id
r4624 r5350 35 35 !!---------------------------------------------------------------------- 36 36 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 37 !! $Id : dtauvd.F90 2392 2010-11-15 21:20:05Z gm$37 !! $Id$ 38 38 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 39 39 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/C1D/dyncor_c1d.F90
- Property svn:keywords set to Id
r2409 r5350 30 30 !!---------------------------------------------------------------------- 31 31 !! NEMO/C1D 3.3 , NEMO Consortium (2010) 32 !! $Id : dyncor_c1d.F90 2382 2010-11-13 13:08:12Z gm$32 !! $Id$ 33 33 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 34 34 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/C1D/dyndmp.F90
- Property svn:keywords set to Id
r5102 r5350 47 47 !!---------------------------------------------------------------------- 48 48 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 49 !! $Id : dyndmp.F90 3294 2012-01-28 16:44:18Z rblod$49 !! $Id$ 50 50 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 51 51 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/C1D/dynnxt_c1d.F90
- Property svn:keywords set to Id
r2409 r5350 25 25 !!---------------------------------------------------------------------- 26 26 !! NEMO/C1D 3.3 , NEMO Consortium (2010) 27 !! $Id : dynnxt_c1d.F90 2382 2010-11-13 13:08:12Z gm$27 !! $Id$ 28 28 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 29 29 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90
- Property svn:keywords set to Id
r5108 r5350 32 32 !!---------------------------------------------------------------------- 33 33 !! NEMO/C1D 3.3 , NEMO Consortium (2010) 34 !! $Id : step_c1d.F90 2382 2010-11-13 13:08:12Z gm$34 !! $Id$ 35 35 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 36 36 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90
- Property svn:keywords set to Id
r4064 r5350 164 164 165 165 166 !! $Id$ 166 167 CONTAINS 167 168 -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/CRS/crsdom.F90
- Property svn:keywords set to Id
r4314 r5350 57 57 # include "domzgr_substitute.h90" 58 58 59 !! $Id$ 59 60 CONTAINS 60 61 … … 1882 1883 CALL crs_lbc_lnk( p_surf_crs_msk, cd_type, 1.0, pval=1.0 ) 1883 1884 1884 CALL wrk_dealloc( jpi, jpj, jpk, zsurf , zsurfmsk)1885 CALL wrk_dealloc( jpi, jpj, jpk, zsurfmsk, zsurf ) 1885 1886 1886 1887 END SUBROUTINE crs_dom_sfc … … 2274 2275 ENDDO 2275 2276 2276 CALL wrk_alloc( jpi_crs, jpj_crs, zmbk )2277 2278 2277 zmbk(:,:) = 0.0 2279 2278 zmbk(:,:) = REAL( mbathy_crs(:,:), wp ) ; CALL crs_lbc_lnk(zmbk,'T',1.0) ; mbathy_crs(:,:) = INT( zmbk(:,:) ) -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/CRS/crsdomwri.F90
- Property svn:keywords set to Id
r4294 r5350 33 33 PUBLIC crs_dom_wri ! routine called by crsini.F90 34 34 35 !! $Id$ 35 36 CONTAINS 36 37 -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90
- Property svn:keywords set to Id
r4149 r5350 38 38 !!---------------------------------------------------------------------- 39 39 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 40 !! $Id 40 !! $Id$ 41 41 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 42 42 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90
- Property svn:keywords set to Id
r4624 r5350 29 29 # include "domzgr_substitute.h90" 30 30 31 !! $Id$ 31 32 CONTAINS 32 33 -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90
- Property svn:keywords set to Id
r4015 r5350 22 22 PUBLIC crs_lbc_lnk 23 23 24 !! $Id$ 24 25 CONTAINS 25 26 -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r5121 r5350 21 21 USE timing ! preformance summary 22 22 USE wrk_nemo ! working arrays 23 USE fldread ! type FLD_N 24 USE phycst ! physical constant 25 USE in_out_manager ! I/O manager 23 26 24 27 IMPLICIT NONE … … 208 211 REAL(wp) :: zztmp 209 212 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zsaldta ! Jan/Dec levitus salinity 213 ! reading initial file 214 LOGICAL :: ln_tsd_init !: T & S data flag 215 LOGICAL :: ln_tsd_tradmp !: internal damping toward input data flag 216 CHARACTER(len=100) :: cn_dir 217 TYPE(FLD_N) :: sn_tem,sn_sal 218 INTEGER :: ios=0 219 220 NAMELIST/namtsd/ ln_tsd_init,ln_tsd_tradmp,cn_dir,sn_tem,sn_sal 221 ! 222 223 REWIND( numnam_ref ) ! Namelist namtsd in reference namelist : 224 READ ( numnam_ref, namtsd, IOSTAT = ios, ERR = 901) 225 901 IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtsd in reference namelist for dia_ar5', lwp ) 226 REWIND( numnam_cfg ) ! Namelist namtsd in configuration namelist : Parameters of the run 227 READ ( numnam_cfg, namtsd, IOSTAT = ios, ERR = 902 ) 228 902 IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtsd in configuration namelist for dia_ar5', lwp ) 229 IF(lwm) WRITE ( numond, namtsd ) 230 ! 210 231 !!---------------------------------------------------------------------- 211 232 ! … … 227 248 END DO 228 249 IF( lk_mpp ) CALL mpp_sum( vol0 ) 229 230 CALL iom_open ( 'data_1m_salinity_nomask', inum )231 CALL iom_get ( inum, jpdom_data, 'vosaline', zsaldta(:,:,:,1), 1 )232 CALL iom_get ( inum, jpdom_data, 'vosaline', zsaldta(:,:,:,2), 12 )250 251 CALL iom_open ( TRIM( cn_dir )//TRIM(sn_sal%clname), inum ) 252 CALL iom_get ( inum, jpdom_data, TRIM(sn_sal%clvar), zsaldta(:,:,:,1), 1 ) 253 CALL iom_get ( inum, jpdom_data, TRIM(sn_sal%clvar), zsaldta(:,:,:,2), 12 ) 233 254 CALL iom_close( inum ) 234 255 sn0(:,:,:) = 0.5_wp * ( zsaldta(:,:,:,1) + zsaldta(:,:,:,2) ) -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90
- Property svn:keywords set to Id
r4624 r5350 42 42 #endif 43 43 #if defined key_lim3 44 USE par_ice45 44 USE ice 46 45 #endif … … 113 112 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: transports_2d 114 113 114 !! $Id$ 115 115 CONTAINS 116 116 … … 1298 1298 LOGICAL, PUBLIC, PARAMETER :: lk_diadct = .FALSE. !: diamht flag 1299 1299 PUBLIC 1300 !! $Id$ 1300 1301 CONTAINS 1301 1302 -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90
- Property svn:keywords set to Id
r4990 r5350 60 60 !!---------------------------------------------------------------------- 61 61 !! NEMO/OPA 3.5 , NEMO Consortium (2013) 62 !! $Id :$62 !! $Id$ 63 63 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 64 64 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
r4990 r5350 8 8 !! 3.2 ! 2010-03 (O. Marti, S. Flavoni) Add fields 9 9 !! 3.3 ! 2010-10 (G. Madec) dynamical allocation 10 !! 3.6 ! 2014-12 (C. Ethe) use of IOM 10 11 !!---------------------------------------------------------------------- 11 12 … … 13 14 !! dia_ptr : Poleward Transport Diagnostics module 14 15 !! dia_ptr_init : Initialization, namelist read 15 !! dia_ptr_wri : Output of poleward fluxes 16 !! ptr_vjk : "zonal" sum computation of a "meridional" flux array 17 !! ptr_tjk : "zonal" mean computation of a tracer field 18 !! ptr_vj : "zonal" and vertical sum computation of a "meridional" flux array 19 !! (Generic interface to ptr_vj_3d, ptr_vj_2d) 16 !! ptr_sjk : "zonal" mean computation of a field - tracer or flux array 17 !! ptr_sj : "zonal" and vertical sum computation of a "meridional" flux array 18 !! (Generic interface to ptr_sj_3d, ptr_sj_2d) 20 19 !!---------------------------------------------------------------------- 21 20 USE oce ! ocean dynamics and active tracers 22 21 USE dom_oce ! ocean space and time domain 23 22 USE phycst ! physical constants 24 USE ldftra_oce ! ocean active tracers: lateral physics 25 USE dianam ! 23 ! 26 24 USE iom ! IOM library 27 USE ioipsl ! IO-IPSL library28 25 USE in_out_manager ! I/O manager 29 26 USE lib_mpp ! MPP library 30 USE lbclnk ! lateral boundary condition - processor exchanges31 27 USE timing ! preformance summary 32 USE wrk_nemo ! working arrays33 28 34 29 IMPLICIT NONE 35 30 PRIVATE 36 31 37 INTERFACE ptr_ vj38 MODULE PROCEDURE ptr_ vj_3d, ptr_vj_2d32 INTERFACE ptr_sj 33 MODULE PROCEDURE ptr_sj_3d, ptr_sj_2d 39 34 END INTERFACE 40 35 41 PUBLIC dia_ptr_init ! call in opa module 36 PUBLIC ptr_sj ! call by tra_ldf & tra_adv routines 37 PUBLIC ptr_sjk ! 38 PUBLIC dia_ptr_init ! call in step module 42 39 PUBLIC dia_ptr ! call in step module 43 PUBLIC ptr_vj ! call by tra_ldf & tra_adv routines44 PUBLIC ptr_vjk ! call by tra_ldf & tra_adv routines45 40 46 41 ! !!** namelist namptr ** 47 LOGICAL , PUBLIC :: ln_diaptr !: Poleward transport flag (T) or not (F) 48 LOGICAL , PUBLIC :: ln_subbas !: Atlantic/Pacific/Indian basins calculation 49 LOGICAL , PUBLIC :: ln_diaznl !: Add zonal means and meridional stream functions 50 LOGICAL , PUBLIC :: ln_ptrcomp !: Add decomposition : overturning (and gyre, soon ...) 51 INTEGER , PUBLIC :: nn_fptr !: frequency of ptr computation [time step] 52 INTEGER , PUBLIC :: nn_fwri !: frequency of ptr outputs [time step] 53 54 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) :: htr_adv, htr_ldf, htr_ove !: Heat TRansports (adv, diff, overturn.) 55 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) :: str_adv, str_ldf, str_ove !: Salt TRansports (adv, diff, overturn.) 42 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) :: htr_adv, htr_ldf !: Heat TRansports (adv, diff, overturn.) 43 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) :: str_adv, str_ldf !: Salt TRansports (adv, diff, overturn.) 56 44 57 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: btmsk ! T-point basin interior masks 58 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: btm30 ! mask out Southern Ocean (=0 south of 30°S) 59 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: htr , str ! adv heat and salt transports (approx) 60 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tn_jk, sn_jk , v_msf ! i-mean T and S, j-Stream-Function 61 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sjk , r1_sjk ! i-mean i-k-surface and its inverse 62 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: htr_eiv, str_eiv ! bolus adv heat ans salt transports ('key_diaeiv') 63 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_msf_eiv ! bolus j-streamfuction ('key_diaeiv') 64 65 66 INTEGER :: niter ! 67 INTEGER :: nidom_ptr ! 68 INTEGER :: numptr ! logical unit for Poleward TRansports 69 INTEGER :: nptr ! = 1 (ln_subbas=F) or = 5 (glo, atl, pac, ind, ipc) (ln_subbas=T) 45 46 LOGICAL, PUBLIC :: ln_diaptr ! Poleward transport flag (T) or not (F) 47 LOGICAL, PUBLIC :: ln_subbas ! Atlantic/Pacific/Indian basins calculation 48 INTEGER :: nptr ! = 1 (l_subbas=F) or = 5 (glo, atl, pac, ind, ipc) (l_subbas=T) 70 49 71 50 REAL(wp) :: rc_sv = 1.e-6_wp ! conversion from m3/s to Sverdrup … … 73 52 REAL(wp) :: rc_ggram = 1.e-6_wp ! conversion from g to Pg 74 53 75 REAL(wp), TARGET, DIMENSION(:), ALLOCATABLE, SAVE :: p_fval1d 76 REAL(wp), TARGET, DIMENSION(:,:), ALLOCATABLE, SAVE :: p_fval2d 77 78 !! Integer, 1D workspace arrays. Not common enough to be implemented in 79 !! wrk_nemo module. 80 INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndex , ndex_atl , ndex_pac , ndex_ind , ndex_ipc 81 INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndex_atl_30 , ndex_pac_30 , ndex_ind_30 , ndex_ipc_30 82 INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndex_h, ndex_h_atl_30, ndex_h_pac_30, ndex_h_ind_30, ndex_h_ipc_30 54 CHARACTER(len=3), ALLOCATABLE, SAVE, DIMENSION(:) :: clsubb 55 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: btmsk ! T-point basin interior masks 56 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: btm30 ! mask out Southern Ocean (=0 south of 30°S) 57 58 REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:) :: p_fval1d 59 REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:,:) :: p_fval2d 60 83 61 84 62 !! * Substitutions … … 92 70 CONTAINS 93 71 94 FUNCTION dia_ptr_alloc() 95 !!---------------------------------------------------------------------- 96 !! *** ROUTINE dia_ptr_alloc *** 97 !!---------------------------------------------------------------------- 98 INTEGER :: dia_ptr_alloc ! return value 99 INTEGER, DIMENSION(6) :: ierr 100 !!---------------------------------------------------------------------- 101 ierr(:) = 0 102 ! 103 ALLOCATE( btmsk(jpi,jpj,nptr) , & 104 & htr_adv(jpj) , str_adv(jpj) , & 105 & htr_ldf(jpj) , str_ldf(jpj) , & 106 & htr_ove(jpj) , str_ove(jpj), & 107 & htr(jpj,nptr) , str(jpj,nptr) , & 108 & tn_jk(jpj,jpk,nptr) , sn_jk (jpj,jpk,nptr) , v_msf(jpj,jpk,nptr) , & 109 & sjk (jpj,jpk,nptr) , r1_sjk(jpj,jpk,nptr) , STAT=ierr(1) ) 110 ! 111 #if defined key_diaeiv 112 ALLOCATE( htr_eiv(jpj,nptr) , str_eiv(jpj,nptr) , & 113 & v_msf_eiv(jpj,jpk,nptr) , STAT=ierr(2) ) 114 #endif 115 ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(3)) 116 ! 117 ALLOCATE(ndex(jpj*jpk), ndex_atl(jpj*jpk), ndex_pac(jpj*jpk), & 118 & ndex_ind(jpj*jpk), ndex_ipc(jpj*jpk), & 119 & ndex_atl_30(jpj*jpk), ndex_pac_30(jpj*jpk), Stat=ierr(4)) 120 121 ALLOCATE(ndex_ind_30(jpj*jpk), ndex_ipc_30(jpj*jpk), & 122 & ndex_h(jpj), ndex_h_atl_30(jpj), ndex_h_pac_30(jpj), & 123 & ndex_h_ind_30(jpj), ndex_h_ipc_30(jpj), Stat=ierr(5) ) 124 ! 125 ALLOCATE( btm30(jpi,jpj) , STAT=ierr(6) ) 126 ! 127 dia_ptr_alloc = MAXVAL( ierr ) 128 IF(lk_mpp) CALL mpp_sum( dia_ptr_alloc ) 129 ! 130 END FUNCTION dia_ptr_alloc 131 132 133 FUNCTION ptr_vj_3d( pva ) RESULT ( p_fval ) 134 !!---------------------------------------------------------------------- 135 !! *** ROUTINE ptr_vj_3d *** 136 !! 137 !! ** Purpose : i-k sum computation of a j-flux array 138 !! 139 !! ** Method : - i-k sum of pva using the interior 2D vmask (vmask_i). 140 !! pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v) 141 !! 142 !! ** Action : - p_fval: i-k-mean poleward flux of pva 143 !!---------------------------------------------------------------------- 144 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pva ! mask flux array at V-point 145 !! 146 INTEGER :: ji, jj, jk ! dummy loop arguments 147 INTEGER :: ijpj ! ??? 148 REAL(wp), POINTER, DIMENSION(:) :: p_fval ! function value 149 !!-------------------------------------------------------------------- 150 ! 151 p_fval => p_fval1d 152 153 ijpj = jpj 154 p_fval(:) = 0._wp 155 DO jk = 1, jpkm1 156 DO jj = 2, jpjm1 157 DO ji = fs_2, fs_jpim1 ! Vector opt. 158 p_fval(jj) = p_fval(jj) + pva(ji,jj,jk) * tmask_i(ji,jj) 159 END DO 160 END DO 161 END DO 162 #if defined key_mpp_mpi 163 IF(lk_mpp) CALL mpp_sum( p_fval, ijpj, ncomm_znl) 164 #endif 165 ! 166 END FUNCTION ptr_vj_3d 167 168 169 FUNCTION ptr_vj_2d( pva ) RESULT ( p_fval ) 170 !!---------------------------------------------------------------------- 171 !! *** ROUTINE ptr_vj_2d *** 172 !! 173 !! ** Purpose : "zonal" and vertical sum computation of a i-flux array 174 !! 175 !! ** Method : - i-k sum of pva using the interior 2D vmask (vmask_i). 176 !! pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v) 177 !! 178 !! ** Action : - p_fval: i-k-mean poleward flux of pva 179 !!---------------------------------------------------------------------- 180 IMPLICIT none 181 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pva ! mask flux array at V-point 182 !! 183 INTEGER :: ji,jj ! dummy loop arguments 184 INTEGER :: ijpj ! ??? 185 REAL(wp), POINTER, DIMENSION(:) :: p_fval ! function value 186 !!-------------------------------------------------------------------- 187 ! 188 p_fval => p_fval1d 189 190 ijpj = jpj 191 p_fval(:) = 0._wp 192 DO jj = 2, jpjm1 193 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 194 p_fval(jj) = p_fval(jj) + pva(ji,jj) * tmask_i(ji,jj) 195 END DO 196 END DO 197 #if defined key_mpp_mpi 198 CALL mpp_sum( p_fval, ijpj, ncomm_znl ) 199 #endif 200 ! 201 END FUNCTION ptr_vj_2d 202 203 204 FUNCTION ptr_vjk( pva, pmsk ) RESULT ( p_fval ) 205 !!---------------------------------------------------------------------- 206 !! *** ROUTINE ptr_vjk *** 207 !! 208 !! ** Purpose : i-sum computation of a j-velocity array 209 !! 210 !! ** Method : - i-sum of pva using the interior 2D vmask (vmask_i). 211 !! pva is supposed to be a masked flux (i.e. * vmask) 212 !! 213 !! ** Action : - p_fval: i-mean poleward flux of pva 214 !!---------------------------------------------------------------------- 215 !! 216 IMPLICIT none 217 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pva ! mask flux array at V-point 218 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) , OPTIONAL :: pmsk ! Optional 2D basin mask 219 !! 220 INTEGER :: ji, jj, jk ! dummy loop arguments 221 REAL(wp), POINTER, DIMENSION(:,:) :: p_fval ! return function value 222 #if defined key_mpp_mpi 223 INTEGER, DIMENSION(1) :: ish 224 INTEGER, DIMENSION(2) :: ish2 225 INTEGER :: ijpjjpk 226 #endif 227 #if defined key_mpp_mpi 228 REAL(wp), POINTER, DIMENSION(:) :: zwork ! mask flux array at V-point 229 #endif 230 !!-------------------------------------------------------------------- 231 ! 232 #if defined key_mpp_mpi 233 ijpjjpk = jpj*jpk 234 CALL wrk_alloc( jpj*jpk, zwork ) 235 #endif 236 237 p_fval => p_fval2d 238 239 p_fval(:,:) = 0._wp 240 ! 241 IF( PRESENT( pmsk ) ) THEN 242 DO jk = 1, jpkm1 243 DO jj = 2, jpjm1 244 !!gm here, use of tmask_i ==> no need of loop over nldi, nlei.... 245 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 246 p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) * pmsk(ji,jj) 72 SUBROUTINE dia_ptr( pvtr ) 73 !!---------------------------------------------------------------------- 74 !! *** ROUTINE dia_ptr *** 75 !!---------------------------------------------------------------------- 76 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: pvtr ! j-effective transport 77 ! 78 INTEGER :: ji, jj, jk, jn ! dummy loop indices 79 REAL(wp) :: zv, zsfc ! local scalar 80 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace 81 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d ! 3D workspace 82 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask ! 3D workspace 83 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zts ! 3D workspace 84 CHARACTER( len = 10 ) :: cl1 85 !!---------------------------------------------------------------------- 86 ! 87 IF( nn_timing == 1 ) CALL timing_start('dia_ptr') 88 89 ! 90 IF( PRESENT( pvtr ) ) THEN 91 IF( iom_use("zomsfglo") ) THEN ! effective MSF 92 z3d(1,:,:) = ptr_sjk( pvtr(:,:,:) ) ! zonal cumulative effective transport 93 DO jk = 2, jpkm1 94 z3d(1,:,jk) = z3d(1,:,jk-1) + z3d(1,:,jk) ! effective j-Stream-Function (MSF) 95 END DO 96 DO ji = 1, jpi 97 z3d(ji,:,:) = z3d(1,:,:) 98 ENDDO 99 cl1 = TRIM('zomsf'//clsubb(1) ) 100 CALL iom_put( cl1, z3d * rc_sv ) 101 DO jn = 2, nptr ! by sub-basins 102 z3d(1,:,:) = ptr_sjk( pvtr(:,:,:), btmsk(:,:,jn)*btm30(:,:) ) 103 DO jk = 2, jpkm1 104 z3d(1,:,jk) = z3d(1,:,jk-1) + z3d(1,:,jk) ! effective j-Stream-Function (MSF) 247 105 END DO 248 END DO 249 END DO 250 ELSE 251 DO jk = 1, jpkm1 252 DO jj = 2, jpjm1 253 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 254 p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) * tmask_i(ji,jj) 255 END DO 256 END DO 257 END DO 258 END IF 259 ! 260 #if defined key_mpp_mpi 261 ijpjjpk = jpj*jpk 262 ish(1) = ijpjjpk ; ish2(1) = jpj ; ish2(2) = jpk 263 zwork(1:ijpjjpk) = RESHAPE( p_fval, ish ) 264 CALL mpp_sum( zwork, ijpjjpk, ncomm_znl ) 265 p_fval(:,:) = RESHAPE( zwork, ish2 ) 266 #endif 267 ! 268 #if defined key_mpp_mpi 269 CALL wrk_dealloc( jpj*jpk, zwork ) 270 #endif 271 ! 272 END FUNCTION ptr_vjk 273 274 275 FUNCTION ptr_tjk( pta, pmsk ) RESULT ( p_fval ) 276 !!---------------------------------------------------------------------- 277 !! *** ROUTINE ptr_tjk *** 278 !! 279 !! ** Purpose : i-sum computation of e1t*e3t * a tracer field 280 !! 281 !! ** Method : - i-sum of mj(pta) using tmask 282 !! 283 !! ** Action : - p_fval: i-sum of e1t*e3t*pta 284 !!---------------------------------------------------------------------- 285 !! 286 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pta ! tracer flux array at T-point 287 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pmsk ! Optional 2D basin mask 288 !! 289 INTEGER :: ji, jj, jk ! dummy loop arguments 290 REAL(wp), POINTER, DIMENSION(:,:) :: p_fval ! return function value 291 #if defined key_mpp_mpi 292 INTEGER, DIMENSION(1) :: ish 293 INTEGER, DIMENSION(2) :: ish2 294 INTEGER :: ijpjjpk 295 #endif 296 #if defined key_mpp_mpi 297 REAL(wp), POINTER, DIMENSION(:) :: zwork ! mask flux array at V-point 298 #endif 299 !!-------------------------------------------------------------------- 300 ! 301 #if defined key_mpp_mpi 302 ijpjjpk = jpj*jpk 303 CALL wrk_alloc( jpj*jpk, zwork ) 304 #endif 305 306 p_fval => p_fval2d 307 308 p_fval(:,:) = 0._wp 309 DO jk = 1, jpkm1 310 DO jj = 2, jpjm1 311 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 312 p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * e1t(ji,jj) * fse3t(ji,jj,jk) * pmsk(ji,jj) 313 END DO 314 END DO 315 END DO 316 #if defined key_mpp_mpi 317 ijpjjpk = jpj*jpk 318 ish(1) = jpj*jpk ; ish2(1) = jpj ; ish2(2) = jpk 319 zwork(1:ijpjjpk)= RESHAPE( p_fval, ish ) 320 CALL mpp_sum( zwork, ijpjjpk, ncomm_znl ) 321 p_fval(:,:)= RESHAPE( zwork, ish2 ) 322 #endif 323 ! 324 #if defined key_mpp_mpi 325 CALL wrk_dealloc( jpj*jpk, zwork ) 326 #endif 327 ! 328 END FUNCTION ptr_tjk 329 330 331 SUBROUTINE dia_ptr( kt ) 332 !!---------------------------------------------------------------------- 333 !! *** ROUTINE dia_ptr *** 334 !!---------------------------------------------------------------------- 335 USE oce, vt => ua ! use ua as workspace 336 USE oce, vs => va ! use va as workspace 337 IMPLICIT none 338 !! 339 INTEGER, INTENT(in) :: kt ! ocean time step index 340 ! 341 INTEGER :: ji, jj, jk, jn ! dummy loop indices 342 REAL(wp) :: zv ! local scalar 343 !!---------------------------------------------------------------------- 344 ! 345 IF( nn_timing == 1 ) CALL timing_start('dia_ptr') 346 ! 347 IF( kt == nit000 .OR. MOD( kt, nn_fptr ) == 0 ) THEN 348 ! 349 IF( MOD( kt, nn_fptr ) == 0 ) THEN 350 ! 351 IF( ln_diaznl ) THEN ! i-mean temperature and salinity 352 DO jn = 1, nptr 353 tn_jk(:,:,jn) = ptr_tjk( tsn(:,:,:,jp_tem), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 354 sn_jk(:,:,jn) = ptr_tjk( tsn(:,:,:,jp_sal), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 355 END DO 356 ENDIF 357 ! 358 ! ! horizontal integral and vertical dz 359 ! ! eulerian velocity 360 v_msf(:,:,1) = ptr_vjk( vn(:,:,:) ) 361 DO jn = 2, nptr 362 v_msf(:,:,jn) = ptr_vjk( vn(:,:,:), btmsk(:,:,jn)*btm30(:,:) ) 363 END DO 364 #if defined key_diaeiv 365 DO jn = 1, nptr ! bolus velocity 366 v_msf_eiv(:,:,jn) = ptr_vjk( v_eiv(:,:,:), btmsk(:,:,jn) ) ! here no btm30 for MSFeiv 367 END DO 368 ! ! add bolus stream-function to the eulerian one 369 v_msf(:,:,:) = v_msf(:,:,:) + v_msf_eiv(:,:,:) 370 #endif 371 ! 372 ! ! Transports 373 ! ! local heat & salt transports at T-points ( tsn*mj[vn+v_eiv] ) 374 vt(:,:,jpk) = 0._wp ; vs(:,:,jpk) = 0._wp 375 DO jk= 1, jpkm1 376 DO jj = 2, jpj 106 DO ji = 1, jpi 107 z3d(ji,:,:) = z3d(1,:,:) 108 ENDDO 109 cl1 = TRIM('zomsf'//clsubb(jn) ) 110 CALL iom_put( cl1, z3d * rc_sv ) 111 END DO 112 ENDIF 113 ! 114 ELSE 115 ! 116 IF( iom_use("zotemglo") ) THEN ! i-mean i-k-surface 117 DO jk = 1, jpkm1 118 DO jj = 1, jpj 377 119 DO ji = 1, jpi 378 #if defined key_diaeiv 379 zv = ( vn(ji,jj,jk) + vn(ji,jj-1,jk) + v_eiv(ji,jj,jk) + v_eiv(ji,jj-1,jk) ) * 0.5_wp 380 #else 381 zv = ( vn(ji,jj,jk) + vn(ji,jj-1,jk) ) * 0.5_wp 382 #endif 383 vt(ji,jj,jk) = zv * tsn(ji,jj,jk,jp_tem) 384 vs(ji,jj,jk) = zv * tsn(ji,jj,jk,jp_sal) 385 END DO 386 END DO 387 END DO 388 !!gm useless as overlap areas are not used in ptr_vjk 389 CALL lbc_lnk( vs, 'V', -1. ) ; CALL lbc_lnk( vt, 'V', -1. ) 390 !!gm 391 ! ! heat & salt advective transports (approximation) 392 htr(:,1) = SUM( ptr_vjk( vt(:,:,:) ) , 2 ) * rc_pwatt ! SUM over jk + conversion 393 str(:,1) = SUM( ptr_vjk( vs(:,:,:) ) , 2 ) * rc_ggram 394 DO jn = 2, nptr 395 htr(:,jn) = SUM( ptr_vjk( vt(:,:,:), btmsk(:,:,jn)*btm30(:,:) ) , 2 ) * rc_pwatt ! mask Southern Ocean 396 str(:,jn) = SUM( ptr_vjk( vs(:,:,:), btmsk(:,:,jn)*btm30(:,:) ) , 2 ) * rc_ggram ! mask Southern Ocean 397 END DO 398 399 IF( ln_ptrcomp ) THEN ! overturning transport 400 htr_ove(:) = SUM( v_msf(:,:,1) * tn_jk(:,:,1), 2 ) * rc_pwatt ! SUM over jk + conversion 401 str_ove(:) = SUM( v_msf(:,:,1) * sn_jk(:,:,1), 2 ) * rc_ggram 402 END IF 403 ! ! Advective and diffusive transport 404 htr_adv(:) = htr_adv(:) * rc_pwatt ! these are computed in tra_adv... and tra_ldf... routines 405 htr_ldf(:) = htr_ldf(:) * rc_pwatt ! here just the conversion in PW and Gg 406 str_adv(:) = str_adv(:) * rc_ggram 407 str_ldf(:) = str_ldf(:) * rc_ggram 408 409 #if defined key_diaeiv 410 DO jn = 1, nptr ! Bolus component 411 htr_eiv(:,jn) = SUM( v_msf_eiv(:,:,jn) * tn_jk(:,:,jn), 2 ) * rc_pwatt ! SUM over jk 412 str_eiv(:,jn) = SUM( v_msf_eiv(:,:,jn) * sn_jk(:,:,jn), 2 ) * rc_ggram ! SUM over jk 413 END DO 414 #endif 415 ! ! "Meridional" Stream-Function 120 zsfc = e1t(ji,jj) * fse3t(ji,jj,jk) 121 zmask(ji,jj,jk) = tmask(ji,jj,jk) * zsfc 122 zts(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem) * zsfc 123 zts(ji,jj,jk,jp_sal) = tsn(ji,jj,jk,jp_sal) * zsfc 124 ENDDO 125 ENDDO 126 ENDDO 416 127 DO jn = 1, nptr 417 DO jk = 2, jpk 418 v_msf (:,jk,jn) = v_msf (:,jk-1,jn) + v_msf (:,jk,jn) ! Eulerian j-Stream-Function 419 #if defined key_diaeiv 420 v_msf_eiv(:,jk,jn) = v_msf_eiv(:,jk-1,jn) + v_msf_eiv(:,jk,jn) ! Bolus j-Stream-Function 421 422 #endif 423 END DO 424 END DO 425 v_msf (:,:,:) = v_msf (:,:,:) * rc_sv ! converte in Sverdrups 426 #if defined key_diaeiv 427 v_msf_eiv(:,:,:) = v_msf_eiv(:,:,:) * rc_sv 428 #endif 429 ENDIF 430 ! 431 CALL dia_ptr_wri( kt ) ! outputs 128 zmask(1,:,:) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) ) 129 cl1 = TRIM('zosrf'//clsubb(jn) ) 130 CALL iom_put( cl1, zmask ) 131 ! 132 z3d(1,:,:) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) & 133 & / MAX( zmask(1,:,:), 10.e-15 ) 134 DO ji = 1, jpi 135 z3d(ji,:,:) = z3d(1,:,:) 136 ENDDO 137 cl1 = TRIM('zotem'//clsubb(jn) ) 138 CALL iom_put( cl1, z3d ) 139 ! 140 z3d(1,:,:) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) & 141 & / MAX( zmask(1,:,:), 10.e-15 ) 142 DO ji = 1, jpi 143 z3d(ji,:,:) = z3d(1,:,:) 144 ENDDO 145 cl1 = TRIM('zosal'//clsubb(jn) ) 146 CALL iom_put( cl1, z3d ) 147 END DO 148 ENDIF 149 ! 150 ! ! Advective and diffusive heat and salt transport 151 IF( iom_use("sophtadv") .OR. iom_use("sopstadv") ) THEN 152 z2d(1,:) = htr_adv(:) * rc_pwatt ! (conversion in PW) 153 DO ji = 1, jpi 154 z2d(ji,:) = z2d(1,:) 155 ENDDO 156 cl1 = 'sophtadv' 157 CALL iom_put( TRIM(cl1), z2d ) 158 z2d(1,:) = str_adv(:) * rc_ggram ! (conversion in Gg) 159 DO ji = 1, jpi 160 z2d(ji,:) = z2d(1,:) 161 ENDDO 162 cl1 = 'sopstadv' 163 CALL iom_put( TRIM(cl1), z2d ) 164 ENDIF 165 ! 166 IF( iom_use("sophtldf") .OR. iom_use("sopstldf") ) THEN 167 z2d(1,:) = htr_ldf(:) * rc_pwatt ! (conversion in PW) 168 DO ji = 1, jpi 169 z2d(ji,:) = z2d(1,:) 170 ENDDO 171 cl1 = 'sophtldf' 172 CALL iom_put( TRIM(cl1), z2d ) 173 z2d(1,:) = str_ldf(:) * rc_ggram ! (conversion in Gg) 174 DO ji = 1, jpi 175 z2d(ji,:) = z2d(1,:) 176 ENDDO 177 cl1 = 'sopstldf' 178 CALL iom_put( TRIM(cl1), z2d ) 179 ENDIF 432 180 ! 433 181 ENDIF 434 !435 #if defined key_mpp_mpi436 IF( kt == nitend .AND. l_znl_root ) CALL histclo( numptr ) ! Close the file437 #else438 IF( kt == nitend ) CALL histclo( numptr ) ! Close the file439 #endif440 182 ! 441 183 IF( nn_timing == 1 ) CALL timing_stop('dia_ptr') … … 450 192 !! ** Purpose : Initialization, namelist read 451 193 !!---------------------------------------------------------------------- 452 INTEGER :: jn ! dummy loop indices 453 INTEGER :: inum, ierr ! local integers 454 INTEGER :: ios ! Local integer output status for namelist read 455 #if defined key_mpp_mpi 456 INTEGER, DIMENSION(1) :: iglo, iloc, iabsf, iabsl, ihals, ihale, idid 457 #endif 458 !! 459 NAMELIST/namptr/ ln_diaptr, ln_diaznl, ln_subbas, ln_ptrcomp, nn_fptr, nn_fwri 194 INTEGER :: jn ! local integers 195 INTEGER :: inum, ierr ! local integers 196 INTEGER :: ios ! Local integer output status for namelist read 197 !! 198 NAMELIST/namptr/ ln_diaptr, ln_subbas 460 199 !!---------------------------------------------------------------------- 461 200 … … 475 214 WRITE(numout,*) ' Namelist namptr : set ptr parameters' 476 215 WRITE(numout,*) ' Poleward heat & salt transport (T) or not (F) ln_diaptr = ', ln_diaptr 477 WRITE(numout,*) ' Overturning heat & salt transport ln_ptrcomp = ', ln_ptrcomp478 WRITE(numout,*) ' T & S zonal mean and meridional stream function ln_diaznl = ', ln_diaznl479 216 WRITE(numout,*) ' Global (F) or glo/Atl/Pac/Ind/Indo-Pac basins ln_subbas = ', ln_subbas 480 WRITE(numout,*) ' Frequency of computation nn_fptr = ', nn_fptr481 WRITE(numout,*) ' Frequency of outputs nn_fwri = ', nn_fwri482 217 ENDIF 483 484 IF( ln_diaptr) THEN 485 486 IF( nn_timing == 1 ) CALL timing_start('dia_ptr_init') 487 488 IF( ln_subbas ) THEN ; nptr = 5 ! Global, Atlantic, Pacific, Indian, Indo-Pacific 489 ELSE ; nptr = 1 ! Global only 218 219 IF( ln_diaptr ) THEN 220 ! 221 IF( ln_subbas ) THEN 222 nptr = 5 ! Global, Atlantic, Pacific, Indian, Indo-Pacific 223 ALLOCATE( clsubb(nptr) ) 224 clsubb(1) = 'glo' ; clsubb(2) = 'atl' ; clsubb(3) = 'pac' ; clsubb(4) = 'ind' ; clsubb(5) = 'ipc' 225 ELSE 226 nptr = 1 ! Global only 227 ALLOCATE( clsubb(nptr) ) 228 clsubb(1) = 'glo' 490 229 ENDIF 491 230 … … 493 232 IF( dia_ptr_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ptr_init : unable to allocate arrays' ) 494 233 495 rc_pwatt = rc_pwatt * rau0 *rcp ! conversion from K.s-1 to PetaWatt234 rc_pwatt = rc_pwatt * rau0_rcp ! conversion from K.s-1 to PetaWatt 496 235 497 236 IF( lk_mpp ) CALL mpp_ini_znl( numout ) ! Define MPI communicator for zonal sum 498 237 499 238 IF( ln_subbas ) THEN ! load sub-basin mask 500 CALL iom_open( 'subbasins', inum )239 CALL iom_open( 'subbasins', inum, ldstop = .FALSE. ) 501 240 CALL iom_get( inum, jpdom_data, 'atlmsk', btmsk(:,:,2) ) ! Atlantic basin 502 241 CALL iom_get( inum, jpdom_data, 'pacmsk', btmsk(:,:,3) ) ! Pacific basin … … 508 247 END WHERE 509 248 ENDIF 249 510 250 btmsk(:,:,1) = tmask_i(:,:) ! global ocean 511 251 … … 513 253 btmsk(:,:,jn) = btmsk(:,:,jn) * tmask_i(:,:) ! interior domain only 514 254 END DO 515 516 IF( lk_vvl ) CALL ctl_stop( 'diaptr: error in vvl case as constant i-mean surface is used' ) 517 518 ! ! i-sum of e1v*e3v surface and its inverse 519 DO jn = 1, nptr 520 sjk(:,:,jn) = ptr_tjk( tmask(:,:,:), btmsk(:,:,jn) ) 521 r1_sjk(:,:,jn) = 0._wp 522 WHERE( sjk(:,:,jn) /= 0._wp ) r1_sjk(:,:,jn) = 1._wp / sjk(:,:,jn) 523 END DO 524 525 ! Initialise arrays to zero because diatpr is called before they are first calculated 526 ! Note that this means diagnostics will not be exactly correct when model run is restarted. 527 htr_adv(:) = 0._wp ; str_adv(:) = 0._wp ; htr_ldf(:) = 0._wp ; str_ldf(:) = 0._wp 528 529 #if defined key_mpp_mpi 530 iglo (1) = jpjglo ! MPP case using MPI ('key_mpp_mpi') 531 iloc (1) = nlcj 532 iabsf(1) = njmppt(narea) 533 iabsl(:) = iabsf(:) + iloc(:) - 1 534 ihals(1) = nldj - 1 535 ihale(1) = nlcj - nlej 536 idid (1) = 2 537 CALL flio_dom_set( jpnj, nproc/jpni, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom_ptr ) 538 #else 539 nidom_ptr = FLIO_DOM_NONE 540 #endif 541 IF( nn_timing == 1 ) CALL timing_stop('dia_ptr_init') 542 ! 255 256 ! Initialise arrays to zero because diatpr is called before they are first calculated 257 ! Note that this means diagnostics will not be exactly correct when model run is restarted. 258 htr_adv(:) = 0._wp ; str_adv(:) = 0._wp 259 htr_ldf(:) = 0._wp ; str_ldf(:) = 0._wp 260 ! 543 261 ENDIF 544 262 ! … … 546 264 547 265 548 SUBROUTINE dia_ptr_wri( kt ) 549 !!--------------------------------------------------------------------- 550 !! *** ROUTINE dia_ptr_wri *** 551 !! 552 !! ** Purpose : output of poleward fluxes 553 !! 554 !! ** Method : NetCDF file 555 !!---------------------------------------------------------------------- 556 !! 557 INTEGER, INTENT(in) :: kt ! ocean time-step index 558 !! 559 INTEGER, SAVE :: nhoridz, ndepidzt, ndepidzw 560 INTEGER, SAVE :: ndim , ndim_atl , ndim_pac , ndim_ind , ndim_ipc 561 INTEGER, SAVE :: ndim_atl_30 , ndim_pac_30 , ndim_ind_30 , ndim_ipc_30 562 INTEGER, SAVE :: ndim_h, ndim_h_atl_30, ndim_h_pac_30, ndim_h_ind_30, ndim_h_ipc_30 563 !! 564 CHARACTER (len=40) :: clhstnam, clop, clop_once, cl_comment ! temporary names 565 INTEGER :: iline, it, itmod, ji, jj, jk ! 566 #if defined key_iomput 567 INTEGER :: inum ! temporary logical unit 266 FUNCTION dia_ptr_alloc() 267 !!---------------------------------------------------------------------- 268 !! *** ROUTINE dia_ptr_alloc *** 269 !!---------------------------------------------------------------------- 270 INTEGER :: dia_ptr_alloc ! return value 271 INTEGER, DIMENSION(3) :: ierr 272 !!---------------------------------------------------------------------- 273 ierr(:) = 0 274 ! 275 ALLOCATE( btmsk(jpi,jpj,nptr) , & 276 & htr_adv(jpj) , str_adv(jpj) , & 277 & htr_ldf(jpj) , str_ldf(jpj) , STAT=ierr(1) ) 278 ! 279 ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(2)) 280 ! 281 ALLOCATE( btm30(jpi,jpj), STAT=ierr(3) ) 282 283 ! 284 dia_ptr_alloc = MAXVAL( ierr ) 285 IF(lk_mpp) CALL mpp_sum( dia_ptr_alloc ) 286 ! 287 END FUNCTION dia_ptr_alloc 288 289 290 FUNCTION ptr_sj_3d( pva, pmsk ) RESULT ( p_fval ) 291 !!---------------------------------------------------------------------- 292 !! *** ROUTINE ptr_sj_3d *** 293 !! 294 !! ** Purpose : i-k sum computation of a j-flux array 295 !! 296 !! ** Method : - i-k sum of pva using the interior 2D vmask (vmask_i). 297 !! pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v) 298 !! 299 !! ** Action : - p_fval: i-k-mean poleward flux of pva 300 !!---------------------------------------------------------------------- 301 REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) :: pva ! mask flux array at V-point 302 REAL(wp), INTENT(in), DIMENSION(jpi,jpj), OPTIONAL :: pmsk ! Optional 2D basin mask 303 ! 304 INTEGER :: ji, jj, jk ! dummy loop arguments 305 INTEGER :: ijpj ! ??? 306 REAL(wp), POINTER, DIMENSION(:) :: p_fval ! function value 307 !!-------------------------------------------------------------------- 308 ! 309 p_fval => p_fval1d 310 311 ijpj = jpj 312 p_fval(:) = 0._wp 313 IF( PRESENT( pmsk ) ) THEN 314 DO jk = 1, jpkm1 315 DO jj = 2, jpjm1 316 DO ji = fs_2, fs_jpim1 ! Vector opt. 317 p_fval(jj) = p_fval(jj) + pva(ji,jj,jk) * tmask_i(ji,jj) * pmsk(ji,jj) 318 END DO 319 END DO 320 END DO 321 ELSE 322 DO jk = 1, jpkm1 323 DO jj = 2, jpjm1 324 DO ji = fs_2, fs_jpim1 ! Vector opt. 325 p_fval(jj) = p_fval(jj) + pva(ji,jj,jk) * tmask_i(ji,jj) 326 END DO 327 END DO 328 END DO 329 ENDIF 330 #if defined key_mpp_mpi 331 IF(lk_mpp) CALL mpp_sum( p_fval, ijpj, ncomm_znl) 568 332 #endif 569 REAL(wp) :: zsto, zout, zdt, zjulian ! temporary scalars 570 !! 571 REAL(wp), POINTER, DIMENSION(:) :: zphi, zfoo ! 1D workspace 572 REAL(wp), POINTER, DIMENSION(:,:) :: z_1 ! 2D workspace 573 !!-------------------------------------------------------------------- 574 ! 575 CALL wrk_alloc( jpj , zphi , zfoo ) 576 CALL wrk_alloc( jpj , jpk , z_1 ) 577 578 ! define time axis 579 it = kt / nn_fptr 580 itmod = kt - nit000 + 1 581 582 ! Initialization 583 ! -------------- 584 IF( kt == nit000 ) THEN 585 niter = ( nit000 - 1 ) / nn_fptr 586 zdt = rdt 587 IF( nacc == 1 ) zdt = rdtmin 588 ! 589 IF(lwp) THEN 590 WRITE(numout,*) 591 WRITE(numout,*) 'dia_ptr_wri : poleward transport and msf writing: initialization , niter = ', niter 592 WRITE(numout,*) '~~~~~~~~~~~~' 593 ENDIF 594 595 ! Reference latitude (used in plots) 596 ! ------------------ 597 ! ! ======================= 598 IF( cp_cfg == "orca" ) THEN ! ORCA configurations 599 ! ! ======================= 600 IF( jp_cfg == 05 ) iline = 192 ! i-line that passes near the North Pole 601 IF( jp_cfg == 025 ) iline = 384 ! i-line that passes near the North Pole 602 IF( jp_cfg == 1 ) iline = 96 ! i-line that passes near the North Pole 603 IF( jp_cfg == 2 ) iline = 48 ! i-line that passes near the North Pole 604 IF( jp_cfg == 4 ) iline = 24 ! i-line that passes near the North Pole 605 zphi(1:jpj) = 0._wp 606 DO ji = mi0(iline), mi1(iline) 607 zphi(1:jpj) = gphiv(ji,:) ! if iline is in the local domain 608 ! Correct highest latitude for some configurations - will work if domain is parallelized in J ? 609 IF( jp_cfg == 05 ) THEN 610 DO jj = mj0(jpjdta), mj1(jpjdta) 611 zphi( jj ) = zphi(mj0(jpjdta-1)) + ( zphi(mj0(jpjdta-1))-zphi(mj0(jpjdta-2)) ) * 0.5_wp 612 zphi( jj ) = MIN( zphi(jj), 90._wp ) 613 END DO 614 END IF 615 IF( jp_cfg == 1 .OR. jp_cfg == 2 .OR. jp_cfg == 4 ) THEN 616 DO jj = mj0(jpjdta-1), mj1(jpjdta-1) 617 zphi( jj ) = 88.5_wp 618 END DO 619 DO jj = mj0(jpjdta ), mj1(jpjdta ) 620 zphi( jj ) = 89.5_wp 621 END DO 622 END IF 623 END DO 624 ! provide the correct zphi to all local domains 333 ! 334 END FUNCTION ptr_sj_3d 335 336 337 FUNCTION ptr_sj_2d( pva, pmsk ) RESULT ( p_fval ) 338 !!---------------------------------------------------------------------- 339 !! *** ROUTINE ptr_sj_2d *** 340 !! 341 !! ** Purpose : "zonal" and vertical sum computation of a i-flux array 342 !! 343 !! ** Method : - i-k sum of pva using the interior 2D vmask (vmask_i). 344 !! pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v) 345 !! 346 !! ** Action : - p_fval: i-k-mean poleward flux of pva 347 !!---------------------------------------------------------------------- 348 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pva ! mask flux array at V-point 349 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj), OPTIONAL :: pmsk ! Optional 2D basin mask 350 ! 351 INTEGER :: ji,jj ! dummy loop arguments 352 INTEGER :: ijpj ! ??? 353 REAL(wp), POINTER, DIMENSION(:) :: p_fval ! function value 354 !!-------------------------------------------------------------------- 355 ! 356 p_fval => p_fval1d 357 358 ijpj = jpj 359 p_fval(:) = 0._wp 360 IF( PRESENT( pmsk ) ) THEN 361 DO jj = 2, jpjm1 362 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 363 p_fval(jj) = p_fval(jj) + pva(ji,jj) * tmask_i(ji,jj) * pmsk(ji,jj) 364 END DO 365 END DO 366 ELSE 367 DO jj = 2, jpjm1 368 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 369 p_fval(jj) = p_fval(jj) + pva(ji,jj) * tmask_i(ji,jj) 370 END DO 371 END DO 372 ENDIF 625 373 #if defined key_mpp_mpi 626 CALL mpp_sum( zphi, jpj, ncomm_znl )374 CALL mpp_sum( p_fval, ijpj, ncomm_znl ) 627 375 #endif 628 ! ! ======================= 629 ELSE ! OTHER configurations 630 ! ! ======================= 631 zphi(1:jpj) = gphiv(1,:) ! assume lat/lon coordinate, select the first i-line 632 ! 633 ENDIF 634 ! 635 ! Work only on westmost processor (will not work if mppini2 is used) 376 ! 377 END FUNCTION ptr_sj_2d 378 379 380 FUNCTION ptr_sjk( pta, pmsk ) RESULT ( p_fval ) 381 !!---------------------------------------------------------------------- 382 !! *** ROUTINE ptr_sjk *** 383 !! 384 !! ** Purpose : i-sum computation of an array 385 !! 386 !! ** Method : - i-sum of pva using the interior 2D vmask (vmask_i). 387 !! 388 !! ** Action : - p_fval: i-mean poleward flux of pva 389 !!---------------------------------------------------------------------- 390 !! 391 IMPLICIT none 392 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pta ! mask flux array at V-point 393 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) , OPTIONAL :: pmsk ! Optional 2D basin mask 394 !! 395 INTEGER :: ji, jj, jk ! dummy loop arguments 396 REAL(wp), POINTER, DIMENSION(:,:) :: p_fval ! return function value 636 397 #if defined key_mpp_mpi 637 IF( l_znl_root ) THEN 398 INTEGER, DIMENSION(1) :: ish 399 INTEGER, DIMENSION(2) :: ish2 400 INTEGER :: ijpjjpk 401 REAL(wp), DIMENSION(jpj*jpk) :: zwork ! mask flux array at V-point 638 402 #endif 639 ! 640 ! OPEN netcdf file 641 ! ---------------- 642 ! Define frequency of output and means 643 zsto = nn_fptr * zdt 644 IF( ln_mskland ) THEN ! put 1.e+20 on land (very expensive!!) 645 clop = "ave(only(x))" 646 clop_once = "once(only(x))" 647 ELSE ! no use of the mask value (require less cpu time) 648 clop = "ave(x)" 649 clop_once = "once" 650 ENDIF 651 652 zout = nn_fwri * zdt 653 zfoo(1:jpj) = 0._wp 654 655 CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian ) ! Compute julian date from starting date of the run 656 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 657 658 #if defined key_iomput 659 ! Requested by IPSL people, use by their postpro... 660 IF(lwp) THEN 661 CALL dia_nam( clhstnam, nn_fwri,' ' ) 662 CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 663 WRITE(inum,*) clhstnam 664 CLOSE(inum) 665 ENDIF 403 !!-------------------------------------------------------------------- 404 ! 405 p_fval => p_fval2d 406 407 p_fval(:,:) = 0._wp 408 ! 409 IF( PRESENT( pmsk ) ) THEN 410 DO jk = 1, jpkm1 411 DO jj = 2, jpjm1 412 !!gm here, use of tmask_i ==> no need of loop over nldi, nlei.... 413 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 414 p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * pmsk(ji,jj) 415 END DO 416 END DO 417 END DO 418 ELSE 419 DO jk = 1, jpkm1 420 DO jj = 2, jpjm1 421 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 422 p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * tmask_i(ji,jj) 423 END DO 424 END DO 425 END DO 426 END IF 427 ! 428 #if defined key_mpp_mpi 429 ijpjjpk = jpj*jpk 430 ish(1) = ijpjjpk ; ish2(1) = jpj ; ish2(2) = jpk 431 zwork(1:ijpjjpk) = RESHAPE( p_fval, ish ) 432 CALL mpp_sum( zwork, ijpjjpk, ncomm_znl ) 433 p_fval(:,:) = RESHAPE( zwork, ish2 ) 666 434 #endif 667 668 CALL dia_nam( clhstnam, nn_fwri, 'diaptr' ) 669 IF(lwp)WRITE( numout,*)" Name of diaptr NETCDF file : ", clhstnam 670 671 ! Horizontal grid : zphi() 672 CALL histbeg(clhstnam, 1, zfoo, jpj, zphi, & 673 1, 1, 1, jpj, niter, zjulian, zdt*nn_fptr, nhoridz, numptr, domain_id=nidom_ptr) 674 ! Vertical grids : gdept_1d, gdepw_1d 675 CALL histvert( numptr, "deptht", "Vertical T levels", & 676 & "m", jpk, gdept_1d, ndepidzt, "down" ) 677 CALL histvert( numptr, "depthw", "Vertical W levels", & 678 & "m", jpk, gdepw_1d, ndepidzw, "down" ) 679 ! 680 CALL wheneq ( jpj*jpk, MIN(sjk(:,:,1), 1._wp), 1, 1., ndex , ndim ) ! Lat-Depth 681 CALL wheneq ( jpj , MIN(sjk(:,1,1), 1._wp), 1, 1., ndex_h, ndim_h ) ! Lat 682 683 IF( ln_subbas ) THEN 684 z_1(:,1) = 1._wp 685 WHERE ( gphit(jpi/2,:) < -30._wp ) z_1(:,1) = 0._wp 686 DO jk = 2, jpk 687 z_1(:,jk) = z_1(:,1) 688 END DO 689 ! ! Atlantic (jn=2) 690 CALL wheneq ( jpj*jpk, MIN(sjk(:,:,2) , 1._wp), 1, 1., ndex_atl , ndim_atl ) ! Lat-Depth 691 CALL wheneq ( jpj*jpk, MIN(sjk(:,:,2)*z_1(:,:), 1._wp), 1, 1., ndex_atl_30 , ndim_atl_30 ) ! Lat-Depth 692 CALL wheneq ( jpj , MIN(sjk(:,1,2)*z_1(:,1), 1._wp), 1, 1., ndex_h_atl_30, ndim_h_atl_30 ) ! Lat 693 ! ! Pacific (jn=3) 694 CALL wheneq ( jpj*jpk, MIN(sjk(:,:,3) , 1._wp), 1, 1., ndex_pac , ndim_pac ) ! Lat-Depth 695 CALL wheneq ( jpj*jpk, MIN(sjk(:,:,3)*z_1(:,:), 1._wp), 1, 1., ndex_pac_30 , ndim_pac_30 ) ! Lat-Depth 696 CALL wheneq ( jpj , MIN(sjk(:,1,3)*z_1(:,1), 1._wp), 1, 1., ndex_h_pac_30, ndim_h_pac_30 ) ! Lat 697 ! ! Indian (jn=4) 698 CALL wheneq ( jpj*jpk, MIN(sjk(:,:,4) , 1._wp), 1, 1., ndex_ind , ndim_ind ) ! Lat-Depth 699 CALL wheneq ( jpj*jpk, MIN(sjk(:,:,4)*z_1(:,:), 1._wp), 1, 1., ndex_ind_30 , ndim_ind_30 ) ! Lat-Depth 700 CALL wheneq ( jpj , MIN(sjk(:,1,4)*z_1(:,1), 1._wp), 1, 1., ndex_h_ind_30, ndim_h_ind_30 ) ! Lat 701 ! ! Indo-Pacific (jn=5) 702 CALL wheneq ( jpj*jpk, MIN(sjk(:,:,5) , 1._wp), 1, 1., ndex_ipc , ndim_ipc ) ! Lat-Depth 703 CALL wheneq ( jpj*jpk, MIN(sjk(:,:,5)*z_1(:,:), 1._wp), 1, 1., ndex_ipc_30 , ndim_ipc_30 ) ! Lat-Depth 704 CALL wheneq ( jpj , MIN(sjk(:,1,5)*z_1(:,1), 1._wp), 1, 1., ndex_h_ipc_30, ndim_h_ipc_30 ) ! Lat 705 ENDIF 706 ! 707 #if defined key_diaeiv 708 cl_comment = ' (Bolus part included)' 709 #else 710 cl_comment = ' ' 711 #endif 712 IF( ln_diaznl ) THEN ! Zonal mean T and S 713 CALL histdef( numptr, "zotemglo", "Zonal Mean Temperature","C" , & 714 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 715 CALL histdef( numptr, "zosalglo", "Zonal Mean Salinity","PSU" , & 716 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 717 718 CALL histdef( numptr, "zosrfglo", "Zonal Mean Surface","m^2" , & 719 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 720 ! 721 IF (ln_subbas) THEN 722 CALL histdef( numptr, "zotematl", "Zonal Mean Temperature: Atlantic","C" , & 723 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 724 CALL histdef( numptr, "zosalatl", "Zonal Mean Salinity: Atlantic","PSU" , & 725 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 726 CALL histdef( numptr, "zosrfatl", "Zonal Mean Surface: Atlantic","m^2" , & 727 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 728 729 CALL histdef( numptr, "zotempac", "Zonal Mean Temperature: Pacific","C" , & 730 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 731 CALL histdef( numptr, "zosalpac", "Zonal Mean Salinity: Pacific","PSU" , & 732 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 733 CALL histdef( numptr, "zosrfpac", "Zonal Mean Surface: Pacific","m^2" , & 734 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 735 736 CALL histdef( numptr, "zotemind", "Zonal Mean Temperature: Indian","C" , & 737 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 738 CALL histdef( numptr, "zosalind", "Zonal Mean Salinity: Indian","PSU" , & 739 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 740 CALL histdef( numptr, "zosrfind", "Zonal Mean Surface: Indian","m^2" , & 741 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 742 743 CALL histdef( numptr, "zotemipc", "Zonal Mean Temperature: Pacific+Indian","C" , & 744 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 745 CALL histdef( numptr, "zosalipc", "Zonal Mean Salinity: Pacific+Indian","PSU" , & 746 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 747 CALL histdef( numptr, "zosrfipc", "Zonal Mean Surface: Pacific+Indian","m^2" , & 748 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 749 ENDIF 750 ENDIF 751 ! 752 ! Meridional Stream-Function (Eulerian and Bolus) 753 CALL histdef( numptr, "zomsfglo", "Meridional Stream-Function: Global"//TRIM(cl_comment),"Sv" , & 754 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 755 IF( ln_subbas .AND. ln_diaznl ) THEN 756 CALL histdef( numptr, "zomsfatl", "Meridional Stream-Function: Atlantic"//TRIM(cl_comment),"Sv" , & 757 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 758 CALL histdef( numptr, "zomsfpac", "Meridional Stream-Function: Pacific"//TRIM(cl_comment),"Sv" , & 759 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 760 CALL histdef( numptr, "zomsfind", "Meridional Stream-Function: Indian"//TRIM(cl_comment),"Sv" , & 761 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 762 CALL histdef( numptr, "zomsfipc", "Meridional Stream-Function: Indo-Pacific"//TRIM(cl_comment),"Sv" ,& 763 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 764 ENDIF 765 ! 766 ! Heat transport 767 CALL histdef( numptr, "sophtadv", "Advective Heat Transport" , & 768 "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 769 CALL histdef( numptr, "sophtldf", "Diffusive Heat Transport" , & 770 "PW",1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 771 IF ( ln_ptrcomp ) THEN 772 CALL histdef( numptr, "sophtove", "Overturning Heat Transport" , & 773 "PW",1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 774 END IF 775 IF( ln_subbas ) THEN 776 CALL histdef( numptr, "sohtatl", "Heat Transport Atlantic"//TRIM(cl_comment), & 777 "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 778 CALL histdef( numptr, "sohtpac", "Heat Transport Pacific"//TRIM(cl_comment) , & 779 "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 780 CALL histdef( numptr, "sohtind", "Heat Transport Indian"//TRIM(cl_comment) , & 781 "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 782 CALL histdef( numptr, "sohtipc", "Heat Transport Pacific+Indian"//TRIM(cl_comment), & 783 "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 784 ENDIF 785 ! 786 ! Salt transport 787 CALL histdef( numptr, "sopstadv", "Advective Salt Transport" , & 788 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 789 CALL histdef( numptr, "sopstldf", "Diffusive Salt Transport" , & 790 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 791 IF ( ln_ptrcomp ) THEN 792 CALL histdef( numptr, "sopstove", "Overturning Salt Transport" , & 793 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 794 END IF 795 #if defined key_diaeiv 796 ! Eddy induced velocity 797 CALL histdef( numptr, "zomsfeiv", "Bolus Meridional Stream-Function: global", & 798 "Sv" , 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 799 CALL histdef( numptr, "sophteiv", "Bolus Advective Heat Transport", & 800 "PW" , 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 801 CALL histdef( numptr, "sopsteiv", "Bolus Advective Salt Transport", & 802 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 803 #endif 804 IF( ln_subbas ) THEN 805 CALL histdef( numptr, "sostatl", "Salt Transport Atlantic"//TRIM(cl_comment) , & 806 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 807 CALL histdef( numptr, "sostpac", "Salt Transport Pacific"//TRIM(cl_comment) , & 808 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 809 CALL histdef( numptr, "sostind", "Salt Transport Indian"//TRIM(cl_comment) , & 810 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 811 CALL histdef( numptr, "sostipc", "Salt Transport Pacific+Indian"//TRIM(cl_comment), & 812 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 813 ENDIF 814 ! 815 CALL histend( numptr ) 816 ! 817 END IF 818 #if defined key_mpp_mpi 819 END IF 820 #endif 821 822 #if defined key_mpp_mpi 823 IF( MOD( itmod, nn_fptr ) == 0 .AND. l_znl_root ) THEN 824 #else 825 IF( MOD( itmod, nn_fptr ) == 0 ) THEN 826 #endif 827 niter = niter + 1 828 829 IF( ln_diaznl ) THEN 830 CALL histwrite( numptr, "zosrfglo", niter, sjk (:,:,1) , ndim, ndex ) 831 CALL histwrite( numptr, "zotemglo", niter, tn_jk(:,:,1) , ndim, ndex ) 832 CALL histwrite( numptr, "zosalglo", niter, sn_jk(:,:,1) , ndim, ndex ) 833 834 IF (ln_subbas) THEN 835 CALL histwrite( numptr, "zosrfatl", niter, sjk(:,:,2), ndim_atl, ndex_atl ) 836 CALL histwrite( numptr, "zosrfpac", niter, sjk(:,:,3), ndim_pac, ndex_pac ) 837 CALL histwrite( numptr, "zosrfind", niter, sjk(:,:,4), ndim_ind, ndex_ind ) 838 CALL histwrite( numptr, "zosrfipc", niter, sjk(:,:,5), ndim_ipc, ndex_ipc ) 839 840 CALL histwrite( numptr, "zotematl", niter, tn_jk(:,:,2) , ndim_atl, ndex_atl ) 841 CALL histwrite( numptr, "zosalatl", niter, sn_jk(:,:,2) , ndim_atl, ndex_atl ) 842 CALL histwrite( numptr, "zotempac", niter, tn_jk(:,:,3) , ndim_pac, ndex_pac ) 843 CALL histwrite( numptr, "zosalpac", niter, sn_jk(:,:,3) , ndim_pac, ndex_pac ) 844 CALL histwrite( numptr, "zotemind", niter, tn_jk(:,:,4) , ndim_ind, ndex_ind ) 845 CALL histwrite( numptr, "zosalind", niter, sn_jk(:,:,4) , ndim_ind, ndex_ind ) 846 CALL histwrite( numptr, "zotemipc", niter, tn_jk(:,:,5) , ndim_ipc, ndex_ipc ) 847 CALL histwrite( numptr, "zosalipc", niter, sn_jk(:,:,5) , ndim_ipc, ndex_ipc ) 848 END IF 849 ENDIF 850 851 ! overturning outputs: 852 CALL histwrite( numptr, "zomsfglo", niter, v_msf(:,:,1), ndim, ndex ) 853 IF( ln_subbas .AND. ln_diaznl ) THEN 854 CALL histwrite( numptr, "zomsfatl", niter, v_msf(:,:,2) , ndim_atl_30, ndex_atl_30 ) 855 CALL histwrite( numptr, "zomsfpac", niter, v_msf(:,:,3) , ndim_pac_30, ndex_pac_30 ) 856 CALL histwrite( numptr, "zomsfind", niter, v_msf(:,:,4) , ndim_ind_30, ndex_ind_30 ) 857 CALL histwrite( numptr, "zomsfipc", niter, v_msf(:,:,5) , ndim_ipc_30, ndex_ipc_30 ) 858 ENDIF 859 #if defined key_diaeiv 860 CALL histwrite( numptr, "zomsfeiv", niter, v_msf_eiv(:,:,1), ndim , ndex ) 861 #endif 862 863 ! heat transport outputs: 864 IF( ln_subbas ) THEN 865 CALL histwrite( numptr, "sohtatl", niter, htr(:,2) , ndim_h_atl_30, ndex_h_atl_30 ) 866 CALL histwrite( numptr, "sohtpac", niter, htr(:,3) , ndim_h_pac_30, ndex_h_pac_30 ) 867 CALL histwrite( numptr, "sohtind", niter, htr(:,4) , ndim_h_ind_30, ndex_h_ind_30 ) 868 CALL histwrite( numptr, "sohtipc", niter, htr(:,5) , ndim_h_ipc_30, ndex_h_ipc_30 ) 869 CALL histwrite( numptr, "sostatl", niter, str(:,2) , ndim_h_atl_30, ndex_h_atl_30 ) 870 CALL histwrite( numptr, "sostpac", niter, str(:,3) , ndim_h_pac_30, ndex_h_pac_30 ) 871 CALL histwrite( numptr, "sostind", niter, str(:,4) , ndim_h_ind_30, ndex_h_ind_30 ) 872 CALL histwrite( numptr, "sostipc", niter, str(:,5) , ndim_h_ipc_30, ndex_h_ipc_30 ) 873 ENDIF 874 875 CALL histwrite( numptr, "sophtadv", niter, htr_adv , ndim_h, ndex_h ) 876 CALL histwrite( numptr, "sophtldf", niter, htr_ldf , ndim_h, ndex_h ) 877 CALL histwrite( numptr, "sopstadv", niter, str_adv , ndim_h, ndex_h ) 878 CALL histwrite( numptr, "sopstldf", niter, str_ldf , ndim_h, ndex_h ) 879 IF( ln_ptrcomp ) THEN 880 CALL histwrite( numptr, "sopstove", niter, str_ove(:) , ndim_h, ndex_h ) 881 CALL histwrite( numptr, "sophtove", niter, htr_ove(:) , ndim_h, ndex_h ) 882 ENDIF 883 #if defined key_diaeiv 884 CALL histwrite( numptr, "sophteiv", niter, htr_eiv(:,1) , ndim_h, ndex_h ) 885 CALL histwrite( numptr, "sopsteiv", niter, str_eiv(:,1) , ndim_h, ndex_h ) 886 #endif 887 ! 888 ENDIF 889 ! 890 CALL wrk_dealloc( jpj , zphi , zfoo ) 891 CALL wrk_dealloc( jpj , jpk, z_1 ) 892 ! 893 END SUBROUTINE dia_ptr_wri 435 ! 436 END FUNCTION ptr_sjk 437 894 438 895 439 !!====================================================================== -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r5107 r5350 78 78 !!---------------------------------------------------------------------- 79 79 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 80 !! $Id 80 !! $Id$ 81 81 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 82 82 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
r5342 r5350 135 135 !!---------------------------------------------------------------------- 136 136 USE ioipsl 137 NAMELIST/namrun/ nn_no , cn_exp , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl , & 138 & nn_it000, nn_itend , nn_date0 , nn_leapy , nn_istate , nn_stock , & 137 NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list, & 138 & nn_no , cn_exp , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl, & 139 & nn_it000, nn_itend , nn_date0 , nn_leapy , nn_istate , nn_stock , & 139 140 & nn_write, ln_dimgnnn, ln_mskland , ln_cfmeta , ln_clobber, nn_chunksz, nn_euler 140 141 NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin, & … … 169 170 WRITE(numout,*) ' experiment name for output cn_exp = ', cn_exp 170 171 WRITE(numout,*) ' file prefix restart input cn_ocerst_in= ', cn_ocerst_in 172 WRITE(numout,*) ' restart input directory cn_ocerst_indir= ', cn_ocerst_indir 171 173 WRITE(numout,*) ' file prefix restart output cn_ocerst_out= ', cn_ocerst_out 174 WRITE(numout,*) ' restart output directory cn_ocerst_outdir= ', cn_ocerst_outdir 172 175 WRITE(numout,*) ' restart logical ln_rstart = ', ln_rstart 173 176 WRITE(numout,*) ' start with forward time step nn_euler = ', nn_euler … … 178 181 WRITE(numout,*) ' leap year calendar (0/1) nn_leapy = ', nn_leapy 179 182 WRITE(numout,*) ' initial state output nn_istate = ', nn_istate 180 WRITE(numout,*) ' frequency of restart file nn_stock = ', nn_stock 183 IF( ln_rst_list ) THEN 184 WRITE(numout,*) ' list of restart dump times nn_stocklist =', nn_stocklist 185 ELSE 186 WRITE(numout,*) ' frequency of restart file nn_stock = ', nn_stock 187 ENDIF 181 188 WRITE(numout,*) ' frequency of output file nn_write = ', nn_write 182 189 WRITE(numout,*) ' multi file dimgout ln_dimgnnn = ', ln_dimgnnn … … 196 203 ninist = nn_istate 197 204 nstock = nn_stock 205 nstocklist = nn_stocklist 198 206 nwrite = nn_write 199 207 neuler = nn_euler 200 IF ( neuler == 1 .AND. .NOT. ln_rstart ) THEN208 IF ( neuler == 1 .AND. .NOT. ln_rstart ) THEN 201 209 WRITE(ctmp1,*) 'ln_rstart =.FALSE., nn_euler is forced to 0 ' 202 210 CALL ctl_warn( ctmp1 ) -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r5120 r5350 472 472 risfdep(:,:)=0.e0 473 473 misfdep(:,:)=1 474 !475 ! (ISF) TODO build ice draft netcdf file for isomip and build the corresponding part of code476 IF( cp_cfg == "isomip" .AND. ln_isfcav ) THEN477 risfdep(:,:)=200.e0478 misfdep(:,:)=1479 ij0 = 1 ; ij1 = 40480 DO jj = mj0(ij0), mj1(ij1)481 risfdep(:,jj)=700.0_wp-(gphit(:,jj)+80.0_wp)*125.0_wp482 END DO483 WHERE( bathy(:,:) <= 0._wp ) risfdep(:,:) = 0._wp484 !485 ELSEIF ( cp_cfg == "isomip2" .AND. ln_isfcav ) THEN486 !487 risfdep(:,:)=0.e0488 misfdep(:,:)=1489 ij0 = 1 ; ij1 = 40490 DO jj = mj0(ij0), mj1(ij1)491 risfdep(:,jj)=700.0_wp-(gphit(:,jj)+80.0_wp)*125.0_wp492 END DO493 WHERE( bathy(:,:) <= 0._wp ) risfdep(:,:) = 0._wp494 END IF495 474 ! 496 475 DEALLOCATE( idta, zdta ) … … 969 948 !! 970 949 INTEGER :: ji, jj, jk ! dummy loop indices 971 INTEGER :: ik, it 950 INTEGER :: ik, it, ikb, ikt ! temporary integers 972 951 LOGICAL :: ll_print ! Allow control print for debugging 973 952 REAL(wp) :: ze3tp , ze3wp ! Last ocean level thickness at T- and W-points … … 1152 1131 IF ( ln_isfcav ) THEN 1153 1132 ! (ISF) define e3uw (adapted for 2 cells in the water column) 1154 ! Need to test if the modification of only mikt and mbkt levels is enough 1155 DO jk = 2,jpk 1156 DO jj = 1, jpjm1 1157 DO ji = 1, fs_jpim1 ! vector opt. 1158 e3uw_0(ji,jj,jk) = MIN( gdept_0(ji,jj,jk), gdept_0(ji+1,jj ,jk) ) & 1159 & - MAX( gdept_0(ji,jj,jk-1), gdept_0(ji+1,jj ,jk-1) ) 1160 e3vw_0(ji,jj,jk) = MIN( gdept_0(ji,jj,jk), gdept_0(ji ,jj+1,jk) ) & 1161 & - MAX( gdept_0(ji,jj,jk-1), gdept_0(ji ,jj+1,jk-1) ) 1162 END DO 1163 END DO 1133 DO jj = 2, jpjm1 1134 DO ji = 2, fs_jpim1 ! vector opt. 1135 ikb = MAX(mbathy (ji,jj),mbathy (ji+1,jj)) 1136 ikt = MAX(misfdep(ji,jj),misfdep(ji+1,jj)) 1137 IF (ikb == ikt+1) e3uw_0(ji,jj,ikb) = MIN( gdept_0(ji,jj,ikb ), gdept_0(ji+1,jj ,ikb ) ) & 1138 & - MAX( gdept_0(ji,jj,ikb-1), gdept_0(ji+1,jj ,ikb-1) ) 1139 ikb = MAX(mbathy (ji,jj),mbathy (ji,jj+1)) 1140 ikt = MAX(misfdep(ji,jj),misfdep(ji,jj+1)) 1141 IF (ikb == ikt+1) e3vw_0(ji,jj,ikb) = MIN( gdept_0(ji,jj,ikb ), gdept_0(ji ,jj+1,ikb ) ) & 1142 & - MAX( gdept_0(ji,jj,ikb-1), gdept_0(ji ,jj+1,ikb-1) ) 1143 END DO 1164 1144 END DO 1165 1145 END IF 1166 1146 1167 1147 CALL lbc_lnk( e3u_0 , 'U', 1._wp ) ; CALL lbc_lnk( e3uw_0, 'U', 1._wp ) ! lateral boundary conditions 1168 1148 CALL lbc_lnk( e3v_0 , 'V', 1._wp ) ; CALL lbc_lnk( e3vw_0, 'V', 1._wp ) … … 1538 1518 1539 1519 ! remove single point "bay" on isf coast line in the ice shelf draft' 1540 DO jk = 1, jpk1520 DO jk = 2, jpk 1541 1521 WHERE (misfdep==0) misfdep=jpk 1542 1522 zmask=0 -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90
- Property svn:keywords set to Id
r4990 r5350 39 39 !!---------------------------------------------------------------------- 40 40 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 41 !! $Id : dtatem.F90 2392 2010-11-15 21:20:05Z gm$41 !! $Id$ 42 42 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 43 43 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
r5120 r5350 69 69 !! ** Purpose : Initialization of the dynamics and tracer fields. 70 70 !!---------------------------------------------------------------------- 71 ! - ML - needed for initialization of e3t_b 72 INTEGER :: ji,jj,jk ! dummy loop indices 73 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zuvd ! U & V data workspace 71 INTEGER :: ji, jj, jk ! dummy loop indices 72 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zuvd ! U & V data workspace 74 73 !!---------------------------------------------------------------------- 75 74 ! … … 84 83 IF( lk_c1d ) CALL dta_uvd_init ! Initialization of U & V input data 85 84 86 rhd (:,:,: ) = 0._wp 87 rhop (:,:,: ) = 0._wp 88 rn2 (:,:,: ) = 0._wp 89 tsa (:,:,:,:) = 0._wp 90 rab_b(:,:,:,:) = 0._wp 91 rab_n(:,:,:,:) = 0._wp 85 rhd (:,:,: ) = 0._wp ; rhop (:,:,: ) = 0._wp ! set one for all to 0 at level jpk 86 rn2b (:,:,: ) = 0._wp ; rn2 (:,:,: ) = 0._wp ! set one for all to 0 at levels 1 and jpk 87 tsa (:,:,:,:) = 0._wp ! set one for all to 0 at level jpk 88 rab_b(:,:,:,:) = 0._wp ; rab_n(:,:,:,:) = 0._wp ! set one for all to 0 at level jpk 92 89 93 90 IF( ln_rstart ) THEN ! Restart from a file … … 113 110 ELSEIF( cp_cfg == 'gyre' ) THEN 114 111 CALL istate_gyre ! GYRE configuration : start from pre-defined T-S fields 115 ELSEIF( cp_cfg == 'isomip' .OR. cp_cfg == 'isomip2') THEN116 IF(lwp) WRITE(numout,*) 'Initialization of T+S for ISOMIP domain'117 tsn(:,:,:,jp_tem)=-1.9*tmask(:,:,:) ! ISOMIP configuration : start from constant T+S fields118 tsn(:,:,:,jp_sal)=34.4*tmask(:,:,:)119 tsb(:,:,:,:)=tsn(:,:,:,:)120 112 ELSE ! Initial T-S, U-V fields read in files 121 113 IF ( ln_tsd_init ) THEN ! read 3D T and S data at nit000 -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90
r5123 r5350 51 51 REAL(wp), PUBLIC :: rcp !: ocean specific heat [J/Kelvin] 52 52 REAL(wp), PUBLIC :: r1_rcp !: = 1. / rcp [Kelvin/J] 53 REAL(wp), PUBLIC :: rau0_rcp !: = rau0 * rcp 53 54 REAL(wp), PUBLIC :: r1_rau0_rcp !: = 1. / ( rau0 * rcp ) 54 55 -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv.F90
r5120 r5350 5 5 !!============================================================================== 6 6 !! History : 1.0 ! 2006-11 (G. Madec) Original code 7 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase 7 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase 8 !! 3.6 ! 2015-05 (N. Ducousso, G. Madec) add Hollingsworth scheme as an option 8 9 !!---------------------------------------------------------------------- 9 10 … … 17 18 USE dynkeg ! kinetic energy gradient (dyn_keg routine) 18 19 USE dynzad ! vertical advection (dyn_zad routine) 20 ! 19 21 USE in_out_manager ! I/O manager 20 22 USE lib_mpp ! MPP library … … 25 27 26 28 PUBLIC dyn_adv ! routine called by step module 27 PUBLIC dyn_adv_init ! routine called by opa module29 PUBLIC dyn_adv_init ! routine called by opa module 28 30 31 ! !* namdyn_adv namelist * 29 32 LOGICAL, PUBLIC :: ln_dynadv_vec !: vector form flag 33 INTEGER, PUBLIC :: nn_dynkeg !: scheme of kinetic energy gradient: =0 C2 ; =1 Hollingsworth 30 34 LOGICAL, PUBLIC :: ln_dynadv_cen2 !: flux form - 2nd order centered scheme flag 31 35 LOGICAL, PUBLIC :: ln_dynadv_ubs !: flux form - 3rd order UBS scheme flag … … 38 42 # include "vectopt_loop_substitute.h90" 39 43 !!---------------------------------------------------------------------- 40 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)44 !! NEMO/OPA 3.6 , NEMO Consortium (2015) 41 45 !! $Id$ 42 46 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 63 67 SELECT CASE ( nadv ) ! compute advection trend and add it to general trend 64 68 CASE ( 0 ) 65 CALL dyn_keg ( kt ) ! vector form : horizontal gradient of kinetic energy66 CALL dyn_zad ( kt ) ! vector form : vertical advection69 CALL dyn_keg ( kt, nn_dynkeg ) ! vector form : horizontal gradient of kinetic energy 70 CALL dyn_zad ( kt ) ! vector form : vertical advection 67 71 CASE ( 1 ) 68 CALL dyn_keg ( kt ) ! vector form : horizontal gradient of kinetic energy69 CALL dyn_zad_zts ( kt ) ! vector form : vertical advection with sub-timestepping72 CALL dyn_keg ( kt, nn_dynkeg ) ! vector form : horizontal gradient of kinetic energy 73 CALL dyn_zad_zts ( kt ) ! vector form : vertical advection with sub-timestepping 70 74 CASE ( 2 ) 71 CALL dyn_adv_cen2( kt ) ! 2nd order centered scheme75 CALL dyn_adv_cen2( kt ) ! 2nd order centered scheme 72 76 CASE ( 3 ) 73 CALL dyn_adv_ubs ( kt ) ! 3rd order UBS scheme77 CALL dyn_adv_ubs ( kt ) ! 3rd order UBS scheme 74 78 ! 75 CASE (-1 ) ! esopa: test all possibility with control print76 CALL dyn_keg ( kt )79 CASE (-1 ) ! esopa: test all possibility with control print 80 CALL dyn_keg ( kt, nn_dynkeg ) 77 81 CALL dyn_zad ( kt ) 78 82 CALL dyn_adv_cen2( kt ) … … 92 96 !! momentum advection formulation & scheme and set nadv 93 97 !!---------------------------------------------------------------------- 94 INTEGER :: ioptio 95 INTEGER :: ios ! Local integer output status for namelist read 96 !! 97 NAMELIST/namdyn_adv/ ln_dynadv_vec, ln_dynadv_cen2 , ln_dynadv_ubs, ln_dynzad_zts 98 INTEGER :: ioptio, ios ! Local integer 99 ! 100 NAMELIST/namdyn_adv/ ln_dynadv_vec, nn_dynkeg, ln_dynadv_cen2 , ln_dynadv_ubs, ln_dynzad_zts 98 101 !!---------------------------------------------------------------------- 99 102 ! 100 103 REWIND( numnam_ref ) ! Namelist namdyn_adv in reference namelist : Momentum advection scheme 101 104 READ ( numnam_ref, namdyn_adv, IOSTAT = ios, ERR = 901) … … 112 115 WRITE(numout,*) '~~~~~~~~~~~' 113 116 WRITE(numout,*) ' Namelist namdyn_adv : chose a advection formulation & scheme for momentum' 114 WRITE(numout,*) ' Vector/flux form (T/F) ln_dynadv_vec = ', ln_dynadv_vec 115 WRITE(numout,*) ' 2nd order centred advection scheme ln_dynadv_cen2 = ', ln_dynadv_cen2 116 WRITE(numout,*) ' 3rd order UBS advection scheme ln_dynadv_ubs = ', ln_dynadv_ubs 117 WRITE(numout,*) ' Sub timestepping of vertical advection ln_dynzad_zts = ', ln_dynzad_zts 117 WRITE(numout,*) ' Vector/flux form (T/F) ln_dynadv_vec = ', ln_dynadv_vec 118 WRITE(numout,*) ' = 0 standard scheme ; =1 Hollingsworth scheme nn_dynkeg = ', nn_dynkeg 119 WRITE(numout,*) ' 2nd order centred advection scheme ln_dynadv_cen2 = ', ln_dynadv_cen2 120 WRITE(numout,*) ' 3rd order UBS advection scheme ln_dynadv_ubs = ', ln_dynadv_ubs 121 WRITE(numout,*) ' Sub timestepping of vertical advection ln_dynzad_zts = ', ln_dynzad_zts 118 122 ENDIF 119 123 … … 126 130 IF( ioptio /= 1 ) CALL ctl_stop( 'Choose ONE advection scheme in namelist namdyn_adv' ) 127 131 IF( ln_dynzad_zts .AND. .NOT. ln_dynadv_vec ) & 128 129 IF( ln_dynzad_zts .AND. ln_isfcav ) &130 CALL ctl_stop( 'Sub timestepping of vertical advection does not work with ln_isfcav = .TRUE.' )132 CALL ctl_stop( 'Sub timestepping of vertical advection requires vector form; set ln_dynadv_vec = .TRUE.' ) 133 IF( nn_dynkeg /= nkeg_C2 .AND. nn_dynkeg /= nkeg_HW ) & 134 CALL ctl_stop( 'KEG scheme wrong value of nn_dynkeg' ) 131 135 132 136 ! ! Set nadv … … 139 143 IF(lwp) THEN ! Print the choice 140 144 WRITE(numout,*) 141 IF( nadv == 0 ) WRITE(numout,*) ' vector form : keg + zad + vor is used' 145 IF( nadv == 0 ) WRITE(numout,*) ' vector form : keg + zad + vor is used' 142 146 IF( nadv == 1 ) WRITE(numout,*) ' vector form : keg + zad_zts + vor is used' 147 IF( nadv == 0 .OR. nadv == 1 ) THEN 148 IF( nn_dynkeg == nkeg_C2 ) WRITE(numout,*) 'with Centered standard keg scheme' 149 IF( nn_dynkeg == nkeg_HW ) WRITE(numout,*) 'with Hollingsworth keg scheme' 150 ENDIF 143 151 IF( nadv == 2 ) WRITE(numout,*) ' flux form : 2nd order scheme is used' 144 152 IF( nadv == 3 ) WRITE(numout,*) ' flux form : UBS scheme is used' -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
r5120 r5350 956 956 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdept, zrhh 957 957 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp 958 REAL(wp), POINTER, DIMENSION(:,:) :: zsshu_n, zsshv_n 958 959 !!---------------------------------------------------------------------- 959 960 ! 960 961 CALL wrk_alloc( jpi,jpj,jpk, zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp ) 961 962 CALL wrk_alloc( jpi,jpj,jpk, zdept, zrhh ) 963 CALL wrk_alloc( jpi,jpj, zsshu_n, zsshv_n ) 962 964 ! 963 965 IF( kt == nit000 ) THEN … … 1040 1042 1041 1043 ! Z coordinate of U(ji,jj,1:jpkm1) and V(ji,jj,1:jpkm1) 1044 1045 ! Prepare zsshu_n and zsshv_n 1042 1046 DO jj = 2, jpjm1 1043 1047 DO ji = 2, jpim1 1044 zu(ji,jj,1) = - ( fse3u(ji,jj,1) - sshn(ji,jj) * znad) ! probable bug: changed from sshu_n for ztilde compilation 1045 zv(ji,jj,1) = - ( fse3v(ji,jj,1) - sshn(ji,jj) * znad) ! probable bug: changed from sshv_n for ztilde compilation 1048 zsshu_n(ji,jj) = (e12u(ji,jj) * sshn(ji,jj) + e12u(ji+1, jj) * sshn(ji+1,jj)) * & 1049 & r1_e12u(ji,jj) * umask(ji,jj,1) * 0.5_wp 1050 zsshv_n(ji,jj) = (e12v(ji,jj) * sshn(ji,jj) + e12v(ji+1, jj) * sshn(ji,jj+1)) * & 1051 & r1_e12v(ji,jj) * vmask(ji,jj,1) * 0.5_wp 1052 END DO 1053 END DO 1054 1055 DO jj = 2, jpjm1 1056 DO ji = 2, jpim1 1057 zu(ji,jj,1) = - ( fse3u(ji,jj,1) - zsshu_n(ji,jj) * znad) 1058 zv(ji,jj,1) = - ( fse3v(ji,jj,1) - zsshv_n(ji,jj) * znad) 1046 1059 END DO 1047 1060 END DO … … 1205 1218 CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp ) 1206 1219 CALL wrk_dealloc( jpi,jpj,jpk, zdept, zrhh ) 1220 CALL wrk_dealloc( jpi,jpj, zsshu_n, zsshv_n ) 1207 1221 ! 1208 1222 END SUBROUTINE hpg_prj -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90
r4990 r5350 4 4 !! Ocean dynamics: kinetic energy gradient trend 5 5 !!====================================================================== 6 !! History : 1.0 ! 87-09 (P. Andrich, m.-a. Foujols) Original code 7 !! 7.0 ! 97-05 (G. Madec) Split dynber into dynkeg and dynhpg 8 !! 9.0 ! 02-07 (G. Madec) F90: Free form and module 6 !! History : 1.0 ! 1987-09 (P. Andrich, M.-A. Foujols) Original code 7 !! 7.0 ! 1997-05 (G. Madec) Split dynber into dynkeg and dynhpg 8 !! NEMO 1.0 ! 2002-07 (G. Madec) F90: Free form and module 9 !! 3.6 ! 2015-05 (N. Ducousso, G. Madec) add Hollingsworth scheme as an option 9 10 !!---------------------------------------------------------------------- 10 11 … … 18 19 ! 19 20 USE in_out_manager ! I/O manager 21 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 20 22 USE lib_mpp ! MPP library 21 23 USE prtctl ! Print control … … 28 30 PUBLIC dyn_keg ! routine called by step module 29 31 32 INTEGER, PARAMETER, PUBLIC :: nkeg_C2 = 0 !: 2nd order centered scheme (standard scheme) 33 INTEGER, PARAMETER, PUBLIC :: nkeg_HW = 1 !: Hollingsworth et al., QJRMS, 1983 34 ! 35 REAL(wp) :: r1_48 = 1._wp / 48._wp !: =1/(4*2*6) 36 30 37 !! * Substitutions 31 38 # include "vectopt_loop_substitute.h90" 32 39 !!---------------------------------------------------------------------- 33 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)40 !! NEMO/OPA 3.6 , NEMO Consortium (2015) 34 41 !! $Id$ 35 42 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 37 44 CONTAINS 38 45 39 SUBROUTINE dyn_keg( kt )46 SUBROUTINE dyn_keg( kt, kscheme ) 40 47 !!---------------------------------------------------------------------- 41 48 !! *** ROUTINE dyn_keg *** … … 45 52 !! general momentum trend. 46 53 !! 47 !! ** Method : Compute the now horizontal kinetic energy 54 !! ** Method : * kscheme = nkeg_C2 : 2nd order centered scheme that 55 !! conserve kinetic energy. Compute the now horizontal kinetic energy 48 56 !! zhke = 1/2 [ mi-1( un^2 ) + mj-1( vn^2 ) ] 57 !! * kscheme = nkeg_HW : Hollingsworth correction following 58 !! Arakawa (2001). The now horizontal kinetic energy is given by: 59 !! zhke = 1/6 [ mi-1( 2 * un^2 + ((un(j+1)+un(j-1))/2)^2 ) 60 !! + mj-1( 2 * vn^2 + ((vn(i+1)+vn(i-1))/2)^2 ) ] 61 !! 49 62 !! Take its horizontal gradient and add it to the general momentum 50 63 !! trend (ua,va). … … 54 67 !! ** Action : - Update the (ua, va) with the hor. ke gradient trend 55 68 !! - send this trends to trd_dyn (l_trddyn=T) for post-processing 69 !! 70 !! ** References : Arakawa, A., International Geophysics 2001. 71 !! Hollingsworth et al., Quart. J. Roy. Meteor. Soc., 1983. 56 72 !!---------------------------------------------------------------------- 57 INTEGER, INTENT( in ) :: kt ! ocean time-step index 73 INTEGER, INTENT( in ) :: kt ! ocean time-step index 74 INTEGER, INTENT( in ) :: kscheme ! =0/1 type of KEG scheme 58 75 ! 59 76 INTEGER :: ji, jj, jk ! dummy loop indices … … 63 80 !!---------------------------------------------------------------------- 64 81 ! 65 IF( nn_timing == 1 ) CALL timing_start('dyn_keg')82 IF( nn_timing == 1 ) CALL timing_start('dyn_keg') 66 83 ! 67 CALL wrk_alloc( jpi, jpj, jpk,zhke )84 CALL wrk_alloc( jpi,jpj,jpk, zhke ) 68 85 ! 69 86 IF( kt == nit000 ) THEN 70 87 IF(lwp) WRITE(numout,*) 71 IF(lwp) WRITE(numout,*) 'dyn_keg : kinetic energy gradient trend '88 IF(lwp) WRITE(numout,*) 'dyn_keg : kinetic energy gradient trend, scheme number=', kscheme 72 89 IF(lwp) WRITE(numout,*) '~~~~~~~' 73 90 ENDIF 74 91 75 92 IF( l_trddyn ) THEN ! Save ua and va trends 76 CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv )93 CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 77 94 ztrdu(:,:,:) = ua(:,:,:) 78 95 ztrdv(:,:,:) = va(:,:,:) 79 96 ENDIF 80 97 81 ! ! =============== 82 DO jk = 1, jpkm1 ! Horizontal slab 83 ! ! =============== 84 DO jj = 2, jpj ! Horizontal kinetic energy at T-point 85 DO ji = fs_2, jpi ! vector opt. 86 zu = 0.25 * ( un(ji-1,jj ,jk) * un(ji-1,jj ,jk) & 87 & + un(ji ,jj ,jk) * un(ji ,jj ,jk) ) 88 zv = 0.25 * ( vn(ji ,jj-1,jk) * vn(ji ,jj-1,jk) & 89 & + vn(ji ,jj ,jk) * vn(ji ,jj ,jk) ) 90 zhke(ji,jj,jk) = zv + zu 91 !!gm simplier coding ==>> ~ faster 92 ! don't forget to suppress local zu zv scalars 93 ! zhke(ji,jj,jk) = 0.25 * ( un(ji-1,jj ,jk) * un(ji-1,jj ,jk) & 94 ! & + un(ji ,jj ,jk) * un(ji ,jj ,jk) & 95 ! & + vn(ji ,jj-1,jk) * vn(ji ,jj-1,jk) & 96 ! & + vn(ji ,jj ,jk) * vn(ji ,jj ,jk) ) 97 !!gm end <<== 98 END DO 99 END DO 100 DO jj = 2, jpjm1 ! add the gradient of kinetic energy to the general momentum trends 98 zhke(:,:,jpk) = 0._wp 99 100 SELECT CASE ( kscheme ) !== Horizontal kinetic energy at T-point ==! 101 ! 102 CASE ( nkeg_C2 ) !-- Standard scheme --! 103 DO jk = 1, jpkm1 104 DO jj = 2, jpj 105 DO ji = fs_2, jpi ! vector opt. 106 zu = un(ji-1,jj ,jk) * un(ji-1,jj ,jk) & 107 & + un(ji ,jj ,jk) * un(ji ,jj ,jk) 108 zv = vn(ji ,jj-1,jk) * vn(ji ,jj-1,jk) & 109 & + vn(ji ,jj ,jk) * vn(ji ,jj ,jk) 110 zhke(ji,jj,jk) = 0.25_wp * ( zv + zu ) 111 END DO 112 END DO 113 END DO 114 ! 115 CASE ( nkeg_HW ) !-- Hollingsworth scheme --! 116 DO jk = 1, jpkm1 117 DO jj = 2, jpjm1 118 DO ji = fs_2, jpim1 ! vector opt. 119 zu = 8._wp * ( un(ji-1,jj ,jk) * un(ji-1,jj ,jk) & 120 & + un(ji ,jj ,jk) * un(ji ,jj ,jk) ) & 121 & + ( un(ji-1,jj-1,jk) + un(ji-1,jj+1,jk) ) * ( un(ji-1,jj-1,jk) + un(ji-1,jj+1,jk) ) & 122 & + ( un(ji ,jj-1,jk) + un(ji ,jj+1,jk) ) * ( un(ji ,jj-1,jk) + un(ji ,jj+1,jk) ) 123 ! 124 zv = 8._wp * ( vn(ji ,jj-1,jk) * vn(ji ,jj-1,jk) & 125 & + vn(ji ,jj ,jk) * vn(ji ,jj ,jk) ) & 126 & + ( vn(ji-1,jj-1,jk) + vn(ji+1,jj-1,jk) ) * ( vn(ji-1,jj-1,jk) + vn(ji+1,jj-1,jk) ) & 127 & + ( vn(ji-1,jj ,jk) + vn(ji+1,jj ,jk) ) * ( vn(ji-1,jj ,jk) + vn(ji+1,jj ,jk) ) 128 zhke(ji,jj,jk) = r1_48 * ( zv + zu ) 129 END DO 130 END DO 131 END DO 132 CALL lbc_lnk( zhke, 'T', 1. ) 133 ! 134 END SELECT 135 ! 136 DO jk = 1, jpkm1 !== grad( KE ) added to the general momentum trends ==! 137 DO jj = 2, jpjm1 101 138 DO ji = fs_2, fs_jpim1 ! vector opt. 102 139 ua(ji,jj,jk) = ua(ji,jj,jk) - ( zhke(ji+1,jj ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj) … … 104 141 END DO 105 142 END DO 106 !!gm idea to be tested ==>> is it faster on scalar computers ? 107 ! DO jj = 2, jpjm1 ! add the gradient of kinetic energy to the general momentum trends 108 ! DO ji = fs_2, fs_jpim1 ! vector opt. 109 ! ua(ji,jj,jk) = ua(ji,jj,jk) - 0.25 * ( + un(ji+1,jj ,jk) * un(ji+1,jj ,jk) & 110 ! & + vn(ji+1,jj-1,jk) * vn(ji+1,jj-1,jk) & 111 ! & + vn(ji+1,jj ,jk) * vn(ji+1,jj ,jk) & 112 ! ! 113 ! & - un(ji-1,jj ,jk) * un(ji-1,jj ,jk) & 114 ! & - vn(ji ,jj-1,jk) * vn(ji ,jj-1,jk) & 115 ! & - vn(ji ,jj ,jk) * vn(ji ,jj ,jk) ) / e1u(ji,jj) 116 ! ! 117 ! va(ji,jj,jk) = va(ji,jj,jk) - 0.25 * ( un(ji-1,jj+1,jk) * un(ji-1,jj+1,jk) & 118 ! & + un(ji ,jj+1,jk) * un(ji ,jj+1,jk) & 119 ! & + vn(ji ,jj+1,jk) * vn(ji ,jj+1,jk) & 120 ! ! 121 ! & - un(ji-1,jj ,jk) * un(ji-1,jj ,jk) & 122 ! & - un(ji ,jj ,jk) * un(ji ,jj ,jk) & 123 ! & - vn(ji ,jj ,jk) * vn(ji ,jj ,jk) ) / e2v(ji,jj) 124 ! END DO 125 ! END DO 126 !!gm en idea <<== 127 ! ! =============== 128 END DO ! End of slab 129 ! ! =============== 130 131 IF( l_trddyn ) THEN ! save the Kinetic Energy trends for diagnostic 143 END DO 144 ! 145 IF( l_trddyn ) THEN ! save the Kinetic Energy trends for diagnostic 132 146 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 133 147 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 134 148 CALL trd_dyn( ztrdu, ztrdv, jpdyn_keg, kt ) 135 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv )149 CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) 136 150 ENDIF 137 151 ! … … 139 153 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 140 154 ! 141 CALL wrk_dealloc( jpi, jpj, jpk,zhke )155 CALL wrk_dealloc( jpi,jpj,jpk, zhke ) 142 156 ! 143 IF( nn_timing == 1 ) CALL timing_stop('dyn_keg')157 IF( nn_timing == 1 ) CALL timing_stop('dyn_keg') 144 158 ! 145 159 END SUBROUTINE dyn_keg -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/DYN/dynnept.F90
- Property svn:keywords set to Id
r4624 r5350 69 69 !!---------------------------------------------------------------------- 70 70 71 !! $Id$ 71 72 CONTAINS 72 73 -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r5120 r5350 79 79 !!---------------------------------------------------------------------- 80 80 !! NEMO/OPA 3.5 , NEMO Consortium (2013) 81 !! $Id : dynspg_ts.F9081 !! $Id$ 82 82 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 83 83 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/FLO/florst.F90
- Property svn:keywords set to Id
r3294 r5350 36 36 !!---------------------------------------------------------------------- 37 37 !! NEMO/OPA 3.2 , LODYC-IPSL (2009) 38 !! $ Header:38 !! $Id$ 39 39 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 40 40 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90
r3294 r5350 50 50 !!---------------------------------------------------------------------- 51 51 !! NEMO/OPA 3.2 , LODYC-IPSL (2009) 52 !! $ Header:52 !! $Id$ 53 53 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 54 54 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/ICB/icb_oce.F90
- Property svn:keywords set to Id
r4990 r5350 146 146 !!---------------------------------------------------------------------- 147 147 !! NEMO/OPA 3.3 , NEMO Consortium (2011) 148 !! $Id : sbc_oce.F90 3340 2012-04-02 11:05:35Z sga$148 !! $Id$ 149 149 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 150 150 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/ICB/icbclv.F90
- Property svn:keywords set to Id
r3821 r5350 33 33 !!---------------------------------------------------------------------- 34 34 !! NEMO/OPA 3.3 , NEMO Consortium (2011) 35 !! $Id :$35 !! $Id$ 36 36 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 37 37 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/ICB/icbdia.F90
- Property svn:keywords set to Id
r3614 r5350 76 76 !!---------------------------------------------------------------------- 77 77 !! NEMO/OPA 3.3 , NEMO Consortium (2011) 78 !! $Id :$78 !! $Id$ 79 79 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 80 80 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/ICB/icbdyn.F90
- Property svn:keywords set to Id
r4990 r5350 28 28 !!---------------------------------------------------------------------- 29 29 !! NEMO/OPA 3.3 , NEMO Consortium (2011) 30 !! $Id :$30 !! $Id$ 31 31 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 32 32 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/ICB/icbini.F90
- Property svn:keywords set to Id
r4990 r5350 41 41 !!---------------------------------------------------------------------- 42 42 !! NEMO/OPA 3.3 , NEMO Consortium (2011) 43 !! $Id :$43 !! $Id$ 44 44 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 45 45 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/ICB/icblbc.F90
- Property svn:keywords set to Id
r4990 r5350 67 67 !!---------------------------------------------------------------------- 68 68 !! NEMO/OPA 3.3 , NEMO Consortium (2011) 69 !! $Id :$69 !! $Id$ 70 70 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 71 71 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/ICB/icbrst.F90
- Property svn:keywords set to Id
r4990 r5350 42 42 !!---------------------------------------------------------------------- 43 43 !! NEMO/OPA 3.3 , NEMO Consortium (2011) 44 !! $Id :$44 !! $Id$ 45 45 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 46 46 !!---------------------------------------------------------------------- … … 64 64 ! start and count arrays 65 65 LOGICAL :: ll_found_restart 66 CHARACTER(len=256) :: cl_path 66 67 CHARACTER(len=256) :: cl_filename 67 68 CHARACTER(len=NF90_MAX_NAME) :: cl_dname … … 70 71 !!---------------------------------------------------------------------- 71 72 72 ! Find a restart file 73 ! Find a restart file. Assume iceberg restarts in same directory as ocean restarts. 74 cl_path = TRIM(cn_ocerst_indir) 75 IF( cl_path(LEN_TRIM(cl_path):) /= '/' ) cl_path = TRIM(cl_path) // '/' 73 76 cl_filename = ' ' 74 77 IF ( lk_mpp ) THEN 75 78 cl_filename = ' ' 76 79 WRITE( cl_filename, '("restart_icebergs_",I4.4,".nc")' ) narea-1 77 INQUIRE( file=TRIM(cl_ filename), exist=ll_found_restart )80 INQUIRE( file=TRIM(cl_path)//TRIM(cl_filename), exist=ll_found_restart ) 78 81 ELSE 79 82 cl_filename = 'restart_icebergs.nc' 80 INQUIRE( file=TRIM(cl_ filename), exist=ll_found_restart )83 INQUIRE( file=TRIM(cl_path)//TRIM(cl_filename), exist=ll_found_restart ) 81 84 ENDIF 82 85 … … 86 89 87 90 IF (nn_verbose_level >= 0 .AND. lwp) & 88 WRITE(numout,'(2a)') 'icebergs, read_restart_bergs: found restart file = ',TRIM(cl_ filename)89 90 nret = NF90_OPEN(TRIM(cl_ filename), NF90_NOWRITE, ncid)91 WRITE(numout,'(2a)') 'icebergs, read_restart_bergs: found restart file = ',TRIM(cl_path)//TRIM(cl_filename) 92 93 nret = NF90_OPEN(TRIM(cl_path)//TRIM(cl_filename), NF90_NOWRITE, ncid) 91 94 IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, read_restart_bergs: nf_open failed') 92 95 … … 228 231 INTEGER :: jn ! dummy loop index 229 232 INTEGER :: ix_dim, iy_dim, ik_dim, in_dim 233 CHARACTER(len=256) :: cl_path 230 234 CHARACTER(len=256) :: cl_filename 231 235 TYPE(iceberg), POINTER :: this … … 233 237 !!---------------------------------------------------------------------- 234 238 239 ! Assume we write iceberg restarts to same directory as ocean restarts. 240 cl_path = TRIM(cn_ocerst_outdir) 241 IF( cl_path(LEN_TRIM(cl_path):) /= '/' ) cl_path = TRIM(cl_path) // '/' 235 242 IF( lk_mpp ) THEN 236 WRITE(cl_filename,'( "icebergs_",I8.8,"_restart_",I4.4,".nc")')kt, narea-1243 WRITE(cl_filename,'(A,"_icebergs_",I8.8,"_restart_",I4.4,".nc")') TRIM(cexper), kt, narea-1 237 244 ELSE 238 WRITE(cl_filename,'( "icebergs_",I8.8,"_restart.nc")')kt239 ENDIF 240 IF (nn_verbose_level >= 0) WRITE(numout,'(2a)') 'icebergs, write_restart: creating ',TRIM(cl_ filename)241 242 nret = NF90_CREATE(TRIM(cl_ filename), NF90_CLOBBER, ncid)245 WRITE(cl_filename,'(A,"_icebergs_",I8.8,"_restart.nc")') TRIM(cexper), kt 246 ENDIF 247 IF (nn_verbose_level >= 0) WRITE(numout,'(2a)') 'icebergs, write_restart: creating ',TRIM(cl_path)//TRIM(cl_filename) 248 249 nret = NF90_CREATE(TRIM(cl_path)//TRIM(cl_filename), NF90_CLOBBER, ncid) 243 250 IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_create failed') 244 251 … … 372 379 ENDIF 373 380 ENDDO 374 IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_ filename),' var: stored_ice written'381 IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_path)//TRIM(cl_filename),' var: stored_ice written' 375 382 376 383 nret = NF90_PUT_VAR( ncid, nkountid, num_bergs(:) ) … … 379 386 nret = NF90_PUT_VAR( ncid, nsheatid, berg_grid%stored_heat(:,:) ) 380 387 IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_put_var stored_heat failed') 381 IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_ filename),' var: stored_heat written'388 IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_path)//TRIM(cl_filename),' var: stored_heat written' 382 389 383 390 nret = NF90_PUT_VAR( ncid, ncalvid , src_calving(:,:) ) … … 385 392 nret = NF90_PUT_VAR( ncid, ncalvhid, src_calving_hflx(:,:) ) 386 393 IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_put_var calving_hflx failed') 387 IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_ filename),' var: calving written'394 IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_path)//TRIM(cl_filename),' var: calving written' 388 395 389 396 IF ( ASSOCIATED(first_berg) ) THEN -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/ICB/icbstp.F90
- Property svn:keywords set to Id
r4990 r5350 46 46 !!---------------------------------------------------------------------- 47 47 !! NEMO/OPA 3.3 , NEMO Consortium (2011) 48 !! $Id :$48 !! $Id$ 49 49 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 50 50 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/ICB/icbthm.F90
- Property svn:keywords set to Id
r3631 r5350 31 31 PUBLIC icb_thm ! routine called in icbstp.F90 module 32 32 33 !! $Id$ 33 34 CONTAINS 34 35 -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/ICB/icbtrj.F90
- Property svn:keywords set to Id
r3614 r5350 44 44 !!---------------------------------------------------------------------- 45 45 !! NEMO/OPA 3.3 , NEMO Consortium (2011) 46 !! $Id :$46 !! $Id$ 47 47 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 48 48 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/ICB/icbutl.F90
- Property svn:keywords set to Id
r4990 r5350 51 51 !!---------------------------------------------------------------------- 52 52 !! NEMO/OPA 3.3 , NEMO Consortium (2011) 53 !! $Id :$53 !! $Id$ 54 54 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 55 55 !!------------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90
r5342 r5350 26 26 CHARACTER(lc) :: cn_exp !: experiment name used for output filename 27 27 CHARACTER(lc) :: cn_ocerst_in !: suffix of ocean restart name (input) 28 CHARACTER(lc) :: cn_ocerst_indir !: restart input directory 28 29 CHARACTER(lc) :: cn_ocerst_out !: suffix of ocean restart name (output) 30 CHARACTER(lc) :: cn_ocerst_outdir !: restart output directory 29 31 LOGICAL :: ln_rstart !: start from (F) rest or (T) a restart file 32 LOGICAL :: ln_rst_list !: output restarts at list of times (T) or by frequency (F) 30 33 INTEGER :: nn_no !: job number 31 34 INTEGER :: nn_rstctl !: control of the time step (0, 1 or 2) … … 38 41 INTEGER :: nn_write !: model standard output frequency 39 42 INTEGER :: nn_stock !: restart file frequency 43 INTEGER, DIMENSION(10) :: nn_stocklist !: restart dump times 40 44 LOGICAL :: ln_dimgnnn !: type of dimgout. (F): 1 file for all proc 41 45 !: (T): 1 file per proc … … 79 83 INTEGER :: nwrite !: model standard output frequency 80 84 INTEGER :: nstock !: restart file frequency 85 INTEGER, DIMENSION(10) :: nstocklist !: restart dump times 81 86 82 87 !!---------------------------------------------------------------------- … … 86 91 LOGICAL :: lrst_oce !: logical to control the oce restart write 87 92 INTEGER :: numror, numrow !: logical unit for cean restart (read and write) 93 INTEGER :: nrst_lst !: number of restart to output next 88 94 89 95 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r5342 r5350 1467 1467 zlatpira = (/ -19.0, -14.0, -8.0, 0.0, 4.0, 8.0, 12.0, 15.0, 20.0 /) 1468 1468 CALL set_mooring( zlonpira, zlatpira ) 1469 1470 ! diaptr : zonal mean 1471 CALL dom_ngb( 180., 90., ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots) 1472 CALL iom_set_domain_attr ('ptr', zoom_ibegin=ix, zoom_nj=jpjglo) 1473 CALL iom_update_file_name('ptr') 1474 ! 1469 1475 1470 1476 END SUBROUTINE set_xmlatt -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90
r4689 r5350 61 61 INTEGER, DIMENSION(2,5), INTENT(in ), OPTIONAL :: kdompar ! domain parameters: 62 62 63 CHARACTER(LEN= 100) :: clinfo ! info character64 CHARACTER(LEN= 100) :: cltmp ! temporary character63 CHARACTER(LEN=256) :: clinfo ! info character 64 CHARACTER(LEN=256) :: cltmp ! temporary character 65 65 INTEGER :: iln ! lengths of character 66 66 INTEGER :: istop ! temporary storage of nstop … … 393 393 INTEGER, DIMENSION(4) :: idimsz ! dimensions size 394 394 INTEGER, DIMENSION(4) :: idimid ! dimensions id 395 CHARACTER(LEN= 100) :: clinfo ! info character395 CHARACTER(LEN=256) :: clinfo ! info character 396 396 CHARACTER(LEN= 12), DIMENSION(4) :: cltmp ! temporary character 397 397 INTEGER :: if90id ! nf90 file identifier -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
r4990 r5350 57 57 !! 58 58 CHARACTER(LEN=20) :: clkt ! ocean time-step deine as a character 59 CHARACTER(LEN=50) :: clname ! ice output restart file name 59 CHARACTER(LEN=50) :: clname ! ocean output restart file name 60 CHARACTER(lc) :: clpath ! full path to ocean output restart file 60 61 !!---------------------------------------------------------------------- 61 62 ! 62 63 IF( kt == nit000 ) THEN ! default definitions 63 64 lrst_oce = .FALSE. 64 nitrst = nitend 65 ENDIF 66 IF( MOD( kt - 1, nstock ) == 0 ) THEN 65 IF( ln_rst_list ) THEN 66 nrst_lst = 1 67 nitrst = nstocklist( nrst_lst ) 68 ELSE 69 nitrst = nitend 70 ENDIF 71 ENDIF 72 73 ! frequency-based restart dumping (nn_stock) 74 IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN 67 75 ! we use kt - 1 and not kt - nit000 to keep the same periodicity from the beginning of the experiment 68 76 nitrst = kt + nstock - 1 ! define the next value of nitrst for restart writing … … 73 81 ! except if we write ocean restart files every time step or if an ocean restart file was writen at nitend - 1 74 82 IF( kt == nitrst - 1 .OR. nstock == 1 .OR. ( kt == nitend .AND. .NOT. lrst_oce ) ) THEN 75 ! beware of the format used to write kt (default is i8.8, that should be large enough...) 76 IF( nitrst > 999999999 ) THEN ; WRITE(clkt, * ) nitrst 77 ELSE ; WRITE(clkt, '(i8.8)') nitrst 78 ENDIF 79 ! create the file 80 clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_ocerst_out) 81 IF(lwp) THEN 82 WRITE(numout,*) 83 SELECT CASE ( jprstlib ) 84 CASE ( jprstdimg ) ; WRITE(numout,*) ' open ocean restart binary file: '//clname 85 CASE DEFAULT ; WRITE(numout,*) ' open ocean restart NetCDF file: '//clname 86 END SELECT 87 IF ( snc4set%luse ) WRITE(numout,*) ' opened for NetCDF4 chunking and compression' 88 IF( kt == nitrst - 1 ) THEN ; WRITE(numout,*) ' kt = nitrst - 1 = ', kt 89 ELSE ; WRITE(numout,*) ' kt = ' , kt 83 IF( nitrst <= nitend .AND. nitrst > 0 ) THEN 84 ! beware of the format used to write kt (default is i8.8, that should be large enough...) 85 IF( nitrst > 999999999 ) THEN ; WRITE(clkt, * ) nitrst 86 ELSE ; WRITE(clkt, '(i8.8)') nitrst 90 87 ENDIF 91 ENDIF 92 ! 93 CALL iom_open( clname, numrow, ldwrt = .TRUE., kiolib = jprstlib ) 94 lrst_oce = .TRUE. 88 ! create the file 89 clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_ocerst_out) 90 clpath = TRIM(cn_ocerst_outdir) 91 IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 92 IF(lwp) THEN 93 WRITE(numout,*) 94 SELECT CASE ( jprstlib ) 95 CASE ( jprstdimg ) ; WRITE(numout,*) & 96 ' open ocean restart binary file: ',TRIM(clpath)//clname 97 CASE DEFAULT ; WRITE(numout,*) & 98 ' open ocean restart NetCDF file: ',TRIM(clpath)//clname 99 END SELECT 100 IF ( snc4set%luse ) WRITE(numout,*) ' opened for NetCDF4 chunking and compression' 101 IF( kt == nitrst - 1 ) THEN ; WRITE(numout,*) ' kt = nitrst - 1 = ', kt 102 ELSE ; WRITE(numout,*) ' kt = ' , kt 103 ENDIF 104 ENDIF 105 ! 106 CALL iom_open( TRIM(clpath)//TRIM(clname), numrow, ldwrt = .TRUE., kiolib = jprstlib ) 107 lrst_oce = .TRUE. 108 ENDIF 95 109 ENDIF 96 110 ! … … 142 156 !!gm not sure what to do here ===>>> ask to Sebastian 143 157 lrst_oce = .FALSE. 158 IF( ln_rst_list ) THEN 159 nrst_lst = MIN(nrst_lst + 1, SIZE(nstocklist,1)) 160 nitrst = nstocklist( nrst_lst ) 161 ENDIF 162 lrst_oce = .FALSE. 144 163 ENDIF 145 164 ! … … 156 175 !! the file has already been opened 157 176 !!---------------------------------------------------------------------- 158 INTEGER :: jlibalt = jprstlib 159 LOGICAL :: llok 177 INTEGER :: jlibalt = jprstlib 178 LOGICAL :: llok 179 CHARACTER(lc) :: clpath ! full path to ocean output restart file 160 180 !!---------------------------------------------------------------------- 161 181 ! … … 171 191 ENDIF 172 192 193 clpath = TRIM(cn_ocerst_indir) 194 IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 173 195 IF ( jprstlib == jprstdimg ) THEN 174 196 ! eventually read netcdf file (monobloc) for restarting on different number of processors 175 197 ! if {cn_ocerst_in}.nc exists, then set jlibalt to jpnf90 176 INQUIRE( FILE = TRIM(cn_ocerst_in )//'.nc', EXIST = llok )198 INQUIRE( FILE = TRIM(cn_ocerst_indir)//'/'//TRIM(cn_ocerst_in)//'.nc', EXIST = llok ) 177 199 IF ( llok ) THEN ; jlibalt = jpnf90 ; ELSE ; jlibalt = jprstlib ; ENDIF 178 200 ENDIF 179 CALL iom_open( cn_ocerst_in, numror, kiolib = jlibalt )201 CALL iom_open( TRIM(clpath)//cn_ocerst_in, numror, kiolib = jlibalt ) 180 202 ENDIF 181 203 END SUBROUTINE rst_read_open -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_smag.F90
- Property svn:keywords set to Id
r3634 r5350 31 31 !!---------------------------------------------------------------------- 32 32 !! OPA 9.0 , LOCEAN-IPSL (2005) 33 !! $Id : ldf_tra_smag.F90 1482 2010-06-13 15:28:06Z$33 !! $Id$ 34 34 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 35 35 !!---------------------------------------------------------------------- … … 51 51 !!---------------------------------------------------------------------- 52 52 !! OPA 9.0 , LOCEAN-IPSL (2005) 53 !! $Id : ldfdyn_c3d.h90 1581 2009-08-05 14:53:12Z smasson$53 !! $Id$ 54 54 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 55 55 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_smag.F90
- Property svn:keywords set to Id
r3634 r5350 31 31 !!---------------------------------------------------------------------- 32 32 !! OPA 9.0 , LOCEAN-IPSL (2005) 33 !! $Id : ldf_tra_smag.F90 1482 2010-06-13 15:28:06Z$33 !! $Id$ 34 34 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 35 35 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/OBS/julian.F90
r2715 r5350 24 24 & greg2jul ! Convert date to relative time 25 25 26 !! $Id$ 26 27 CONTAINS 27 28 -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/SBC/cyclone.F90
- Property svn:keywords set to Id
r4230 r5350 41 41 !!---------------------------------------------------------------------- 42 42 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 43 !! $Id : module_example 1146 2008-06-25 11:42:56Z rblod$43 !! $Id$ 44 44 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 45 45 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90
- Property svn:keywords set to Id
r4624 r5350 43 43 !!---------------------------------------------------------------------- 44 44 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 45 !! $Id :$45 !! $Id$ 46 46 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 47 47 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90
- Property svn:keywords set to Id
r4990 r5350 46 46 !!---------------------------------------------------------------------- 47 47 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 48 !! $Id : sbcblk_mfs.F90 1730 2009-11-16 14:34:19Z poddo$48 !! $Id$ 49 49 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 50 50 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r5166 r5350 1199 1199 ENDDO 1200 1200 ELSE 1201 qns_tot(:,: ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1) 1201 1202 DO jl=1,jpl 1202 qns_tot(:,: ) = qns_tot(:,:) + zicefr(:,:) * frcv(jpr_qnsice)%z3(:,:,1)1203 1203 qns_ice(:,:,jl) = frcv(jpr_qnsice)%z3(:,:,1) 1204 1204 ENDDO … … 1258 1258 ENDDO 1259 1259 ELSE 1260 qsr_tot(:,: ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1) 1260 1261 DO jl=1,jpl 1261 qsr_tot(:,: ) = qsr_tot(:,:) + zicefr(:,:) * frcv(jpr_qsrice)%z3(:,:,1)1262 1262 qsr_ice(:,:,jl) = frcv(jpr_qsrice)%z3(:,:,1) 1263 1263 ENDDO -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
- Property svn:keywords set to Id
r5133 r5350 96 96 # include "domzgr_substitute.h90" 97 97 98 !! $Id$ 98 99 CONTAINS 99 100 … … 1095 1096 !! Default option Dummy module NO CICE sea-ice model 1096 1097 !!---------------------------------------------------------------------- 1098 !! $Id$ 1097 1099 CONTAINS 1098 1100 -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r5128 r5350 184 184 numit = numit + nn_fsbc ! Ice model time step 185 185 ! 186 CALL sbc_lim_ update! Store previous ice values186 CALL sbc_lim_bef ! Store previous ice values 187 187 188 188 CALL sbc_lim_diag0 ! set diag of mass, heat and salt fluxes to 0 … … 202 202 203 203 #if defined key_bdy 204 CALL lim_var_glo2eqv205 204 CALL bdy_ice_lim( kt ) ! bdy ice thermo 206 CALL lim_var_zapsmall207 CALL lim_var_agg(1)208 205 IF( ln_icectl ) CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' ) 209 206 #endif … … 212 209 ENDIF 213 210 214 CALL sbc_lim_ update! Store previous ice values211 CALL sbc_lim_bef ! Store previous ice values 215 212 216 213 ! ---------------------------------------------- 217 214 ! ice thermodynamics 218 215 ! ---------------------------------------------- 219 CALL lim_var_glo2eqv220 216 CALL lim_var_agg(1) 221 217 … … 248 244 ! 249 245 IF( lrst_ice ) CALL lim_rst_write( kt ) ! Ice restart file 250 CALL lim_var_glo2eqv ! ??? 251 ! 252 IF( ln_icectl ) CALL lim_ctl( kt ) ! alerts in case of model crash 246 ! 247 IF( ln_icectl ) CALL lim_ctl( kt ) ! alerts in case of model crash 253 248 ! 254 249 CALL wrk_dealloc( jpi,jpj,jpl, zalb_os, zalb_cs, zalb_ice ) … … 351 346 !!------------------------------------------------------------------- 352 347 INTEGER :: ios ! Local integer output status for namelist read 353 NAMELIST/namicerun/ jpl, nlay_i, nlay_s, cn_icerst_in, cn_icerst_ out,&348 NAMELIST/namicerun/ jpl, nlay_i, nlay_s, cn_icerst_in, cn_icerst_indir, cn_icerst_out, cn_icerst_outdir, & 354 349 & ln_limdyn, rn_amax, ln_limdiahsb, ln_limdiaout, ln_icectl, iiceprt, jiceprt 355 350 !!------------------------------------------------------------------- … … 389 384 r1_nlay_s = 1._wp / REAL( nlay_s, wp ) 390 385 ! 386 #if defined key_bdy 387 IF( lwp .AND. ln_limdiahsb ) CALL ctl_warn('online conservation check activated but it does not work with BDY') 388 #endif 389 ! 391 390 END SUBROUTINE ice_run 392 391 … … 555 554 END SUBROUTINE ice_lim_flx 556 555 557 SUBROUTINE sbc_lim_ update558 !!---------------------------------------------------------------------- 559 !! *** ROUTINE sbc_lim_ update***556 SUBROUTINE sbc_lim_bef 557 !!---------------------------------------------------------------------- 558 !! *** ROUTINE sbc_lim_bef *** 560 559 !! 561 560 !! ** purpose : store ice variables at "before" time step … … 571 570 v_ice_b(:,:) = v_ice(:,:) 572 571 573 END SUBROUTINE sbc_lim_ update572 END SUBROUTINE sbc_lim_bef 574 573 575 574 SUBROUTINE sbc_lim_diag0 … … 602 601 hfx_spr(:,:) = 0._wp ; hfx_dif(:,:) = 0._wp 603 602 hfx_err(:,:) = 0._wp ; hfx_err_rem(:,:) = 0._wp 603 hfx_err_dif(:,:) = 0._wp ; 604 604 605 605 afx_tot(:,:) = 0._wp ; 606 606 afx_dyn(:,:) = 0._wp ; afx_thd(:,:) = 0._wp 607 607 608 diag_heat_dhc(:,:) = 0._wp ; 608 diag_heat(:,:) = 0._wp ; diag_smvi(:,:) = 0._wp ; 609 diag_vice(:,:) = 0._wp ; diag_vsnw(:,:) = 0._wp ; 609 610 610 611 END SUBROUTINE sbc_lim_diag0 … … 635 636 636 637 fice_ice_ave (:,:) = 0.0_wp 637 WHERE ( at_i (:,:) .GT.0.0_wp ) fice_ice_ave (:,:) = fice_cell_ave ( ptab (:,:,:)) / at_i (:,:)638 WHERE ( at_i (:,:) > 0.0_wp ) fice_ice_ave (:,:) = fice_cell_ave ( ptab (:,:,:)) / at_i (:,:) 638 639 639 640 END FUNCTION fice_ice_ave -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90
- Property svn:keywords set to Id
r5120 r5350 80 80 !!---------------------------------------------------------------------- 81 81 !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 82 !! $Id : sbcice_if.F90 1730 2009-11-16 14:34:19Z smasson$82 !! $Id$ 83 83 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 84 84 !!---------------------------------------------------------------------- … … 561 561 CALL iom_put('isfgammat', zgammat2d) 562 562 CALL iom_put('isfgammas', zgammas2d) 563 ! 564 !CALL wrk_dealloc( jpi,jpj, zfrz,zpress,zti, zqisf, zfwfisf ) 563 ! 565 564 CALL wrk_dealloc( jpi,jpj, zfrz,zpress,zti, zgammat2d, zgammas2d ) 566 565 ! -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/SBC/sbctide.F90
- Property svn:keywords set to Id
r4292 r5350 36 36 !!---------------------------------------------------------------------- 37 37 !! NEMO/OPA 3.5 , NEMO Consortium (2013) 38 !! $Id :$38 !! $Id$ 39 39 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 40 40 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90
- Property svn:keywords set to Id
r4624 r5350 39 39 !!---------------------------------------------------------------------- 40 40 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 41 !! $Id :$41 !! $Id$ 42 42 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 43 43 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/SBC/tide_mod.F90
- Property svn:keywords set to Id
r4292 r5350 35 35 !!---------------------------------------------------------------------- 36 36 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 37 !! $Id :$37 !! $Id$ 38 38 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 39 39 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/SBC/tideini.F90
- Property svn:keywords set to Id
r4624 r5350 36 36 !!---------------------------------------------------------------------- 37 37 !! NEMO/OPA 3.5 , NEMO Consortium (2013) 38 !! $Id :$38 !! $Id$ 39 39 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 40 40 !!---------------------------------------------------------------------- … … 80 80 END DO 81 81 END DO 82 ! 83 ! Ensure that tidal components have been set in namelist_cfg 84 IF( nb_harmo .EQ. 0 ) CALL ctl_stop( 'tide_init : No tidal components set in nam_tide' ) 82 85 ! 83 86 IF(lwp) THEN -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/SBC/updtide.F90
- Property svn:keywords set to Id
r4292 r5350 26 26 !!---------------------------------------------------------------------- 27 27 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 28 !! $Id : sbcfwb.F90 3625 2012-11-21 13:19:18Z acc$28 !! $Id$ 29 29 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 30 30 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
r4990 r5350 47 47 USE lbclnk ! ocean lateral boundary conditions 48 48 USE timing ! Timing 49 USE stopar ! Stochastic T/S fluctuations 50 USE stopts ! Stochastic T/S fluctuations 49 51 50 52 IMPLICIT NONE … … 313 315 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pdep ! depth [m] 314 316 ! 315 INTEGER :: ji, jj, jk ! dummy loop indices 316 REAL(wp) :: zt , zh , zs , ztm ! local scalars 317 REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - - 317 INTEGER :: ji, jj, jk, jsmp ! dummy loop indices 318 INTEGER :: jdof 319 REAL(wp) :: zt , zh , zstemp, zs , ztm ! local scalars 320 REAL(wp) :: zn , zn0, zn1, zn2, zn3 ! - - 321 REAL(wp), DIMENSION(:), ALLOCATABLE :: zn0_sto, zn_sto, zsign ! local vectors 318 322 !!---------------------------------------------------------------------- 319 323 ! … … 324 328 CASE( -1, 0 ) !== polynomial TEOS-10 / EOS-80 ==! 325 329 ! 326 DO jk = 1, jpkm1 327 DO jj = 1, jpj 328 DO ji = 1, jpi 329 ! 330 zh = pdep(ji,jj,jk) * r1_Z0 ! depth 331 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 332 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 333 ztm = tmask(ji,jj,jk) ! tmask 334 ! 335 zn3 = EOS013*zt & 336 & + EOS103*zs+EOS003 337 ! 338 zn2 = (EOS022*zt & 339 & + EOS112*zs+EOS012)*zt & 340 & + (EOS202*zs+EOS102)*zs+EOS002 341 ! 342 zn1 = (((EOS041*zt & 343 & + EOS131*zs+EOS031)*zt & 344 & + (EOS221*zs+EOS121)*zs+EOS021)*zt & 345 & + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt & 346 & + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 347 ! 348 zn0 = (((((EOS060*zt & 349 & + EOS150*zs+EOS050)*zt & 350 & + (EOS240*zs+EOS140)*zs+EOS040)*zt & 351 & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt & 352 & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt & 353 & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt & 354 & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 355 ! 356 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 357 ! 358 prhop(ji,jj,jk) = zn0 * ztm ! potential density referenced at the surface 359 ! 360 prd(ji,jj,jk) = ( zn * r1_rau0 - 1._wp ) * ztm ! density anomaly (masked) 330 ! Stochastic equation of state 331 IF ( ln_sto_eos ) THEN 332 ALLOCATE(zn0_sto(1:2*nn_sto_eos)) 333 ALLOCATE(zn_sto(1:2*nn_sto_eos)) 334 ALLOCATE(zsign(1:2*nn_sto_eos)) 335 DO jsmp = 1, 2*nn_sto_eos, 2 336 zsign(jsmp) = 1._wp 337 zsign(jsmp+1) = -1._wp 338 END DO 339 ! 340 DO jk = 1, jpkm1 341 DO jj = 1, jpj 342 DO ji = 1, jpi 343 ! 344 ! compute density (2*nn_sto_eos) times: 345 ! (1) for t+dt, s+ds (with the random TS fluctutation computed in sto_pts) 346 ! (2) for t-dt, s-ds (with the opposite fluctuation) 347 DO jsmp = 1, nn_sto_eos*2 348 jdof = (jsmp + 1) / 2 349 zh = pdep(ji,jj,jk) * r1_Z0 ! depth 350 zt = (pts (ji,jj,jk,jp_tem) + pts_ran(ji,jj,jk,jp_tem,jdof) * zsign(jsmp)) * r1_T0 ! temperature 351 zstemp = pts (ji,jj,jk,jp_sal) + pts_ran(ji,jj,jk,jp_sal,jdof) * zsign(jsmp) 352 zs = SQRT( ABS( zstemp + rdeltaS ) * r1_S0 ) ! square root salinity 353 ztm = tmask(ji,jj,jk) ! tmask 354 ! 355 zn3 = EOS013*zt & 356 & + EOS103*zs+EOS003 357 ! 358 zn2 = (EOS022*zt & 359 & + EOS112*zs+EOS012)*zt & 360 & + (EOS202*zs+EOS102)*zs+EOS002 361 ! 362 zn1 = (((EOS041*zt & 363 & + EOS131*zs+EOS031)*zt & 364 & + (EOS221*zs+EOS121)*zs+EOS021)*zt & 365 & + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt & 366 & + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 367 ! 368 zn0_sto(jsmp) = (((((EOS060*zt & 369 & + EOS150*zs+EOS050)*zt & 370 & + (EOS240*zs+EOS140)*zs+EOS040)*zt & 371 & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt & 372 & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt & 373 & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt & 374 & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 375 ! 376 zn_sto(jsmp) = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0_sto(jsmp) 377 END DO 378 ! 379 ! compute stochastic density as the mean of the (2*nn_sto_eos) densities 380 prhop(ji,jj,jk) = 0._wp ; prd(ji,jj,jk) = 0._wp 381 DO jsmp = 1, nn_sto_eos*2 382 prhop(ji,jj,jk) = prhop(ji,jj,jk) + zn0_sto(jsmp) ! potential density referenced at the surface 383 ! 384 prd(ji,jj,jk) = prd(ji,jj,jk) + ( zn_sto(jsmp) * r1_rau0 - 1._wp ) ! density anomaly (masked) 385 END DO 386 prhop(ji,jj,jk) = 0.5_wp * prhop(ji,jj,jk) * ztm / nn_sto_eos 387 prd (ji,jj,jk) = 0.5_wp * prd (ji,jj,jk) * ztm / nn_sto_eos 388 END DO 361 389 END DO 362 390 END DO 363 END DO 364 ! 391 DEALLOCATE(zn0_sto,zn_sto,zsign) 392 ! Non-stochastic equation of state 393 ELSE 394 DO jk = 1, jpkm1 395 DO jj = 1, jpj 396 DO ji = 1, jpi 397 ! 398 zh = pdep(ji,jj,jk) * r1_Z0 ! depth 399 zt = pts (ji,jj,jk,jp_tem) * r1_T0 ! temperature 400 zs = SQRT( ABS( pts(ji,jj,jk,jp_sal) + rdeltaS ) * r1_S0 ) ! square root salinity 401 ztm = tmask(ji,jj,jk) ! tmask 402 ! 403 zn3 = EOS013*zt & 404 & + EOS103*zs+EOS003 405 ! 406 zn2 = (EOS022*zt & 407 & + EOS112*zs+EOS012)*zt & 408 & + (EOS202*zs+EOS102)*zs+EOS002 409 ! 410 zn1 = (((EOS041*zt & 411 & + EOS131*zs+EOS031)*zt & 412 & + (EOS221*zs+EOS121)*zs+EOS021)*zt & 413 & + ((EOS311*zs+EOS211)*zs+EOS111)*zs+EOS011)*zt & 414 & + (((EOS401*zs+EOS301)*zs+EOS201)*zs+EOS101)*zs+EOS001 415 ! 416 zn0 = (((((EOS060*zt & 417 & + EOS150*zs+EOS050)*zt & 418 & + (EOS240*zs+EOS140)*zs+EOS040)*zt & 419 & + ((EOS330*zs+EOS230)*zs+EOS130)*zs+EOS030)*zt & 420 & + (((EOS420*zs+EOS320)*zs+EOS220)*zs+EOS120)*zs+EOS020)*zt & 421 & + ((((EOS510*zs+EOS410)*zs+EOS310)*zs+EOS210)*zs+EOS110)*zs+EOS010)*zt & 422 & + (((((EOS600*zs+EOS500)*zs+EOS400)*zs+EOS300)*zs+EOS200)*zs+EOS100)*zs+EOS000 423 ! 424 zn = ( ( zn3 * zh + zn2 ) * zh + zn1 ) * zh + zn0 425 ! 426 prhop(ji,jj,jk) = zn0 * ztm ! potential density referenced at the surface 427 ! 428 prd(ji,jj,jk) = ( zn * r1_rau0 - 1._wp ) * ztm ! density anomaly (masked) 429 END DO 430 END DO 431 END DO 432 ENDIF 433 365 434 CASE( 1 ) !== simplified EOS ==! 366 435 ! … … 1589 1658 END SELECT 1590 1659 ! 1660 rau0_rcp = rau0 * rcp 1591 1661 r1_rau0 = 1._wp / rau0 1592 1662 r1_rcp = 1._wp / rcp 1593 r1_rau0_rcp = 1._wp / ( rau0 * rcp )1663 r1_rau0_rcp = 1._wp / rau0_rcp 1594 1664 ! 1595 1665 IF(lwp) WRITE(numout,*) … … 1597 1667 IF(lwp) WRITE(numout,*) ' 1. / rau0 r1_rau0 = ', r1_rau0, ' m^3/kg' 1598 1668 IF(lwp) WRITE(numout,*) ' ocean specific heat rcp = ', rcp , ' J/Kelvin' 1669 IF(lwp) WRITE(numout,*) ' rau0 * rcp rau0_rcp = ', rau0_rcp 1599 1670 IF(lwp) WRITE(numout,*) ' 1. / ( rau0 * rcp ) r1_rau0_rcp = ', r1_rau0_rcp 1600 1671 ! -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
r5130 r5350 26 26 USE cla ! cross land advection (cla_traadv routine) 27 27 USE ldftra_oce ! lateral diffusion coefficient on tracers 28 ! 28 29 USE in_out_manager ! I/O manager 29 30 USE iom ! I/O module … … 33 34 USE timing ! Timing 34 35 USE sbc_oce 36 USE diaptr ! Poleward heat transport 35 37 36 38 … … 111 113 ! 112 114 IF( ln_mle ) CALL tra_adv_mle( kt, nit000, zun, zvn, zwn, 'TRA' ) ! add the mle transport (if necessary) 115 ! 113 116 CALL iom_put( "uocetr_eff", zun ) ! output effective transport 114 117 CALL iom_put( "vocetr_eff", zvn ) 115 118 CALL iom_put( "wocetr_eff", zwn ) 116 119 ! 120 IF( ln_diaptr ) CALL dia_ptr( zvn ) ! diagnose the effective MSF 121 ! 122 117 123 SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==! 118 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, nit000, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! 2nd order centered119 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD120 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsa, jpts, ln_traadv_msc_ups ) ! MUSCL121 CASE ( 4 ) ; CALL tra_adv_muscl2 ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! MUSCL2122 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! UBS123 CASE ( 6 ) ; CALL tra_adv_qck ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! QUICKEST124 CASE ( 7 ) ; CALL tra_adv_tvd_zts( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD ZTS124 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, nit000, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! 2nd order centered 125 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD 126 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsa, jpts, ln_traadv_msc_ups ) ! MUSCL 127 CASE ( 4 ) ; CALL tra_adv_muscl2 ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! MUSCL2 128 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! UBS 129 CASE ( 6 ) ; CALL tra_adv_qck ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! QUICKEST 130 CASE ( 7 ) ; CALL tra_adv_tvd_zts( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD ZTS 125 131 ! 126 132 CASE (-1 ) !== esopa: test all possibility with control print ==! -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90
r4990 r5350 279 279 END IF 280 280 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 281 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN282 IF( jn == jp_tem ) htr_adv(:) = ptr_ vj( zwy(:,:,:) )283 IF( jn == jp_sal ) str_adv(:) = ptr_ vj( zwy(:,:,:) )281 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 282 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 283 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 284 284 ENDIF 285 285 ! -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90
- Property svn:keywords set to Id
r4835 r5350 53 53 !!---------------------------------------------------------------------- 54 54 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 55 !! $Id :$55 !! $Id$ 56 56 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 57 57 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90
r4990 r5350 21 21 USE trdtra ! tracers trends manager 22 22 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient 23 USE sbcrnf 23 USE sbcrnf ! river runoffs 24 24 USE diaptr ! poleward transport diagnostics 25 25 ! … … 219 219 END IF 220 220 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 221 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN222 IF( jn == jp_tem ) htr_adv(:) = ptr_ vj( zwy(:,:,:) )223 IF( jn == jp_sal ) str_adv(:) = ptr_ vj( zwy(:,:,:) )221 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 222 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 223 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 224 224 ENDIF 225 225 -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90
r4990 r5350 200 200 201 201 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 202 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN203 IF( jn == jp_tem ) htr_adv(:) = ptr_ vj( zwy(:,:,:) )204 IF( jn == jp_sal ) str_adv(:) = ptr_ vj( zwy(:,:,:) )202 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 203 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 204 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 205 205 ENDIF 206 206 -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90
r4990 r5350 355 355 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) ) 356 356 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 357 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN358 IF( jn == jp_tem ) htr_adv(:) = ptr_ vj( zwy(:,:,:) )359 IF( jn == jp_sal ) str_adv(:) = ptr_ vj( zwy(:,:,:) )357 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 358 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 359 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 360 360 ENDIF 361 361 ! -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r5120 r5350 193 193 END IF 194 194 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 195 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN196 IF( jn == jp_tem ) htr_adv(:) = ptr_ vj( zwy(:,:,:) )197 IF( jn == jp_sal ) str_adv(:) = ptr_ vj( zwy(:,:,:) )195 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 196 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 197 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 198 198 ENDIF 199 199 … … 264 264 END IF 265 265 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 266 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN267 IF( jn == jp_tem ) htr_adv(:) = ptr_ vj( zwy(:,:,:) ) + htr_adv(:)268 IF( jn == jp_sal ) str_adv(:) = ptr_ vj( zwy(:,:,:) ) + str_adv(:)266 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 267 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:) 268 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:) 269 269 ENDIF 270 270 ! … … 430 430 END IF 431 431 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 432 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN433 IF( jn == jp_tem ) htr_adv(:) = ptr_ vj( zwy(:,:,:) )434 IF( jn == jp_sal ) str_adv(:) = ptr_ vj( zwy(:,:,:) )432 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 433 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 434 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 435 435 ENDIF 436 436 … … 556 556 END IF 557 557 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 558 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN559 IF( jn == jp_tem ) htr_adv(:) = ptr_ vj( zwy(:,:,:) ) + htr_adv(:)560 IF( jn == jp_sal ) str_adv(:) = ptr_ vj( zwy(:,:,:) ) + str_adv(:)558 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 559 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:) 560 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:) 561 561 ENDIF 562 562 ! -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90
r4990 r5350 177 177 END IF 178 178 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 179 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN180 IF( jn == jp_tem ) htr_adv(:) = ptr_ vj( ztv(:,:,:) )181 IF( jn == jp_sal ) str_adv(:) = ptr_ vj( ztv(:,:,:) )179 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 180 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( ztv(:,:,:) ) 181 IF( jn == jp_sal ) str_adv(:) = ptr_sj( ztv(:,:,:) ) 182 182 ENDIF 183 183 -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90
r4990 r5350 42 42 !!---------------------------------------------------------------------- 43 43 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 44 !! $Id $44 !! $Id$ 45 45 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 46 46 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90
r5120 r5350 173 173 ! 174 174 ! "zonal" mean lateral diffusive heat and salt transport 175 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN176 IF( jn == jp_tem ) htr_ldf(:) = ptr_ vj( ztv(:,:,:) )177 IF( jn == jp_sal ) str_ldf(:) = ptr_ vj( ztv(:,:,:) )175 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 176 IF( jn == jp_tem ) htr_ldf(:) = ptr_sj( ztv(:,:,:) ) 177 IF( jn == jp_sal ) str_ldf(:) = ptr_sj( ztv(:,:,:) ) 178 178 ENDIF 179 179 ! ! =========== -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90
r4292 r5350 247 247 ! ! =============== 248 248 ! "Poleward" diffusive heat or salt transport 249 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( kaht == 2 ) .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN249 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( kaht == 2 ) ) THEN 250 250 ! note sign is reversed to give down-gradient diffusive transports (#1043) 251 IF( jn == jp_tem) htr_ldf(:) = ptr_ vj( -zftv(:,:,:) )252 IF( jn == jp_sal) str_ldf(:) = ptr_ vj( -zftv(:,:,:) )251 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( -zftv(:,:,:) ) 252 IF( jn == jp_sal) str_ldf(:) = ptr_sj( -zftv(:,:,:) ) 253 253 ENDIF 254 254 -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
r5120 r5350 28 28 USE in_out_manager ! I/O manager 29 29 USE iom ! I/O library 30 #if defined key_diaar531 30 USE phycst ! physical constants 32 31 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 33 #endif34 32 USE wrk_nemo ! Memory Allocation 35 33 USE timing ! Timing … … 110 108 REAL(wp) :: zmskv, zabe2, zcof2, zcoef4 ! - - 111 109 REAL(wp) :: zcoef0, zbtr, ztra ! - - 112 #if defined key_diaar5113 REAL(wp) :: zztmp ! local scalar114 #endif115 110 REAL(wp), POINTER, DIMENSION(:,: ) :: z2d 116 111 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdkt, zdk1t, zdit, zdjt, ztfw … … 240 235 ! 241 236 ! "Poleward" diffusive heat or salt transports (T-S case only) 242 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN237 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 243 238 ! note sign is reversed to give down-gradient diffusive transports (#1043) 244 IF( jn == jp_tem) htr_ldf(:) = ptr_ vj( -zftv(:,:,:) )245 IF( jn == jp_sal) str_ldf(:) = ptr_ vj( -zftv(:,:,:) )239 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( -zftv(:,:,:) ) 240 IF( jn == jp_sal) str_ldf(:) = ptr_sj( -zftv(:,:,:) ) 246 241 ENDIF 247 242 248 #if defined key_diaar5 249 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN250 z2d(:,:) = 0._wp251 ! note sign is reversed to give down-gradient diffusive transports (#1043)252 zztmp = -1.0_wp * rau0 * rcp253 DO jk = 1, jpkm1254 DO jj = 2, jpjm1255 DO ji = fs_2, fs_jpim1 ! vector opt.256 z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk)243 IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN 244 ! 245 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN 246 z2d(:,:) = 0._wp 247 DO jk = 1, jpkm1 248 DO jj = 2, jpjm1 249 DO ji = fs_2, fs_jpim1 ! vector opt. 250 z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 251 END DO 257 252 END DO 258 253 END DO 259 END DO 260 z2d(:,:) = zztmp * z2d(:,:) 261 CALL lbc_lnk( z2d, 'U', -1. ) 262 CALL iom_put( "udiff_heattr", z2d ) ! heat transport in i-direction 263 z2d(:,:) = 0._wp 264 DO jk = 1, jpkm1 265 DO jj = 2, jpjm1 266 DO ji = fs_2, fs_jpim1 ! vector opt. 267 z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 254 z2d(:,:) = - rau0_rcp * z2d(:,:) ! note sign is reversed to give down-gradient diffusive transports (#1043) 255 CALL lbc_lnk( z2d, 'U', -1. ) 256 CALL iom_put( "udiff_heattr", z2d ) ! heat transport in i-direction 257 ! 258 z2d(:,:) = 0._wp 259 DO jk = 1, jpkm1 260 DO jj = 2, jpjm1 261 DO ji = fs_2, fs_jpim1 ! vector opt. 262 z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 263 END DO 268 264 END DO 269 265 END DO 270 END DO271 z2d(:,:) = zztmp * z2d(:,:)272 CALL lbc_lnk( z2d, 'V', -1. )273 CALL iom_put( "vdiff_heattr", z2d ) ! heat transport in i-direction274 END IF275 #endif 266 z2d(:,:) = - rau0_rcp * z2d(:,:) ! note sign is reversed to give down-gradient diffusive transports (#1043) 267 CALL lbc_lnk( z2d, 'V', -1. ) 268 CALL iom_put( "vdiff_heattr", z2d ) ! heat transport in i-direction 269 END IF 270 ! 271 ENDIF 276 272 277 273 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90
r4990 r5350 113 113 REAL(wp) :: ze1ur, zdxt, ze2vr, ze3wr, zdyt, zdzt 114 114 REAL(wp) :: zah, zah_slp, zaei_slp 115 #if defined key_diaar5116 REAL(wp) :: zztmp ! local scalar117 #endif118 115 REAL(wp), POINTER, DIMENSION(:,: ) :: z2d 119 116 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdit, zdjt, ztfw … … 207 204 END DO 208 205 ! 209 #if defined key_iomput 210 IF( ln_traldf_gdia .AND. cdtype == 'TRA' ) THEN 211 CALL wrk_alloc( jpi , jpj , jpk , zw3d ) 212 DO jk=1,jpkm1 213 zw3d(:,:,jk) = (psix_eiv(:,:,jk+1) - psix_eiv(:,:,jk))/fse3u(:,:,jk) ! u_eiv = -dpsix/dz 214 END DO 215 zw3d(:,:,jpk) = 0._wp 216 CALL iom_put( "uoce_eiv", zw3d ) ! i-eiv current 217 218 DO jk=1,jpk-1 219 zw3d(:,:,jk) = (psiy_eiv(:,:,jk+1) - psiy_eiv(:,:,jk))/fse3v(:,:,jk) ! v_eiv = -dpsiy/dz 220 END DO 221 zw3d(:,:,jpk) = 0._wp 222 CALL iom_put( "voce_eiv", zw3d ) ! j-eiv current 223 224 DO jk=1,jpk-1 225 DO jj = 2, jpjm1 226 DO ji = fs_2, fs_jpim1 ! vector opt. 227 zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))/e2t(ji,jj) + & 228 & (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))/e1t(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx 229 END DO 230 END DO 231 END DO 232 zw3d(:,:,jpk) = 0._wp 233 CALL iom_put( "woce_eiv", zw3d ) ! vert. eiv current 234 CALL wrk_dealloc( jpi , jpj , jpk , zw3d ) 206 IF( iom_use("uoce_eiv") .OR. iom_use("voce_eiv") .OR. iom_use("woce_eiv") ) THEN 207 ! 208 IF( ln_traldf_gdia .AND. cdtype == 'TRA' ) THEN 209 CALL wrk_alloc( jpi , jpj , jpk , zw3d ) 210 DO jk=1,jpkm1 211 zw3d(:,:,jk) = (psix_eiv(:,:,jk+1) - psix_eiv(:,:,jk))/fse3u(:,:,jk) ! u_eiv = -dpsix/dz 212 END DO 213 zw3d(:,:,jpk) = 0._wp 214 CALL iom_put( "uoce_eiv", zw3d ) ! i-eiv current 215 216 DO jk=1,jpk-1 217 zw3d(:,:,jk) = (psiy_eiv(:,:,jk+1) - psiy_eiv(:,:,jk))/fse3v(:,:,jk) ! v_eiv = -dpsiy/dz 218 END DO 219 zw3d(:,:,jpk) = 0._wp 220 CALL iom_put( "voce_eiv", zw3d ) ! j-eiv current 221 222 DO jk=1,jpk-1 223 DO jj = 2, jpjm1 224 DO ji = fs_2, fs_jpim1 ! vector opt. 225 zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))/e2t(ji,jj) + & 226 & (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))/e1t(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx 227 END DO 228 END DO 229 END DO 230 zw3d(:,:,jpk) = 0._wp 231 CALL iom_put( "woce_eiv", zw3d ) ! vert. eiv current 232 CALL wrk_dealloc( jpi , jpj , jpk , zw3d ) 233 ENDIF 234 ! 235 235 ENDIF 236 #endif237 236 ! ! =========== 238 237 DO jn = 1, kjpt ! tracer loop … … 387 386 ! 388 387 ! ! "Poleward" diffusive heat or salt transports (T-S case only) 389 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN390 IF( jn == jp_tem) htr_ldf(:) = ptr_ vj( zftv(:,:,:) ) ! 3.3 names391 IF( jn == jp_sal) str_ldf(:) = ptr_ vj( zftv(:,:,:) )388 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 389 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( zftv(:,:,:) ) ! 3.3 names 390 IF( jn == jp_sal) str_ldf(:) = ptr_sj( zftv(:,:,:) ) 392 391 ENDIF 393 392 394 #if defined key_diaar5 395 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN 396 z2d(:,:) = 0._wp 397 zztmp = rau0 * rcp 398 DO jk = 1, jpkm1 399 DO jj = 2, jpjm1 400 DO ji = fs_2, fs_jpim1 ! vector opt. 401 z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 402 END DO 403 END DO 404 END DO 405 z2d(:,:) = zztmp * z2d(:,:) 406 CALL lbc_lnk( z2d, 'U', -1. ) 407 CALL iom_put( "udiff_heattr", z2d ) ! heat transport in i-direction 408 z2d(:,:) = 0._wp 409 DO jk = 1, jpkm1 410 DO jj = 2, jpjm1 411 DO ji = fs_2, fs_jpim1 ! vector opt. 412 z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 413 END DO 414 END DO 415 END DO 416 z2d(:,:) = zztmp * z2d(:,:) 417 CALL lbc_lnk( z2d, 'V', -1. ) 418 CALL iom_put( "vdiff_heattr", z2d ) ! heat transport in j-direction 419 END IF 420 #endif 393 IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN 394 ! 395 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN 396 z2d(:,:) = 0._wp 397 DO jk = 1, jpkm1 398 DO jj = 2, jpjm1 399 DO ji = fs_2, fs_jpim1 ! vector opt. 400 z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 401 END DO 402 END DO 403 END DO 404 z2d(:,:) = rau0_rcp * z2d(:,:) 405 CALL lbc_lnk( z2d, 'U', -1. ) 406 CALL iom_put( "udiff_heattr", z2d ) ! heat transport in i-direction 407 ! 408 z2d(:,:) = 0._wp 409 DO jk = 1, jpkm1 410 DO jj = 2, jpjm1 411 DO ji = fs_2, fs_jpim1 ! vector opt. 412 z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 413 END DO 414 END DO 415 END DO 416 z2d(:,:) = rau0_rcp * z2d(:,:) 417 CALL lbc_lnk( z2d, 'V', -1. ) 418 CALL iom_put( "vdiff_heattr", z2d ) ! heat transport in i-direction 419 END IF 420 ! 421 ENDIF 421 422 ! 422 423 END DO -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90
r5120 r5350 154 154 ! 155 155 ! "Poleward" diffusive heat or salt transports 156 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN157 IF( jn == jp_tem) htr_ldf(:) = ptr_ vj( ztv(:,:,:) )158 IF( jn == jp_sal) str_ldf(:) = ptr_ vj( ztv(:,:,:) )156 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 157 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( ztv(:,:,:) ) 158 IF( jn == jp_sal) str_ldf(:) = ptr_sj( ztv(:,:,:) ) 159 159 ENDIF 160 160 ! ! ================== -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRD/trd_oce.F90
- Property svn:keywords set to Id
r4990 r5350 76 76 !!---------------------------------------------------------------------- 77 77 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 78 !! $Id : trd_oce.F90 3318 2012-02-25 15:50:01Z gm$78 !! $Id$ 79 79 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 80 80 !!====================================================================== -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRD/trddyn.F90
- Property svn:keywords set to Id
r4990 r5350 40 40 !!---------------------------------------------------------------------- 41 41 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 42 !! $Id : trddyn.F90 3325 2012-03-12 14:44:43Z gm$42 !! $Id$ 43 43 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 44 44 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRD/trdglo.F90
- Property svn:keywords set to Id
r4990 r5350 56 56 !!---------------------------------------------------------------------- 57 57 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 58 !! $Id : trdglo.F90 3325 2012-03-12 14:44:43Z gm$58 !! $Id$ 59 59 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 60 60 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRD/trdini.F90
- Property svn:keywords set to Id
r4990 r5350 30 30 !!---------------------------------------------------------------------- 31 31 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 32 !! $Id : trdini.F90 3329 2012-03-16 12:22:15Z gm$32 !! $Id$ 33 33 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 34 34 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90
- Property svn:keywords set to Id
r4990 r5350 44 44 !!---------------------------------------------------------------------- 45 45 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 46 !! $Id : trdken.F90 3329 2012-03-16 12:22:15Z gm$46 !! $Id$ 47 47 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 48 48 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90
- Property svn:keywords set to Id
r4990 r5350 77 77 !!---------------------------------------------------------------------- 78 78 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 79 !! $Id : trdmxl.F90 3318 2012-02-25 15:50:01Z gm$79 !! $Id$ 80 80 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 81 81 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_oce.F90
- Property svn:keywords set to Id
r4990 r5350 83 83 !!---------------------------------------------------------------------- 84 84 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 85 !! $Id :$85 !! $Id$ 86 86 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 87 87 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_rst.F90
- Property svn:keywords set to Id
r4990 r5350 27 27 !!--------------------------------------------------------------------------------- 28 28 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 29 !! $Id : $29 !! $Id$ 30 30 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 31 31 !!--------------------------------------------------------------------------------- … … 43 43 INTEGER :: jk ! loop indice 44 44 CHARACTER(LEN=20) :: clkt ! ocean time-step deine as a character 45 CHARACTER(LEN=50) :: clname ! ice output restart file name 45 CHARACTER(LEN=50) :: clname ! output restart file name 46 CHARACTER(LEN=256) :: clpath ! full path to restart file 46 47 !!-------------------------------------------------------------------------------- 47 48 … … 56 57 ! create the file 57 58 clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_trdrst_out) 59 clpath = TRIM(cn_ocerst_outdir) 60 IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 58 61 IF(lwp) THEN 59 62 WRITE(numout,*) … … 67 70 ENDIF 68 71 69 CALL iom_open( clname, nummxlw, ldwrt = .TRUE., kiolib = jprstlib )72 CALL iom_open( TRIM(clpath)//TRIM(clname), nummxlw, ldwrt = .TRUE., kiolib = jprstlib ) 70 73 ENDIF 71 74 … … 133 136 INTEGER :: jlibalt = jprstlib 134 137 LOGICAL :: llok 138 CHARACTER(LEN=256) :: clpath ! full path to restart file 135 139 !!----------------------------------------------------------------------------- 136 140 … … 140 144 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~' 141 145 ENDIF 146 147 clpath = TRIM(cn_ocerst_indir) 148 IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 149 142 150 IF ( jprstlib == jprstdimg ) THEN 143 151 ! eventually read netcdf file (monobloc) for restarting on different number of processors 144 152 ! if {cn_trdrst_in}.nc exists, then set jlibalt to jpnf90 145 INQUIRE( FILE = TRIM(c n_trdrst_in)//'.nc', EXIST = llok )153 INQUIRE( FILE = TRIM(clpath)//TRIM(cn_trdrst_in)//'.nc', EXIST = llok ) 146 154 IF ( llok ) THEN ; jlibalt = jpnf90 147 155 ELSE ; jlibalt = jprstlib … … 149 157 ENDIF 150 158 151 CALL iom_open( cn_trdrst_in, inum, kiolib = jlibalt )159 CALL iom_open( TRIM(clpath)//TRIM(cn_trdrst_in), inum, kiolib = jlibalt ) 152 160 153 161 IF( ln_trdmxl_instant ) THEN -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90
- Property svn:keywords set to Id
r4990 r5350 41 41 !!---------------------------------------------------------------------- 42 42 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 43 !! $Id : trdtra.F90 3318 2012-02-25 15:50:01Z gm$43 !! $Id$ 44 44 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 45 45 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/TRD/trdtrc.F90
- Property svn:keywords set to Id
r4990 r5350 18 18 !!---------------------------------------------------------------------- 19 19 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 20 !! $Id : trdtrc.F90 2715 2011-03-30 15:58:35Z rblod$20 !! $Id$ 21 21 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 22 22 !!====================================================================== -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90
r5120 r5350 171 171 END DO 172 172 END DO 173 CALL lbc_lnk( bfrua, 'U', 1. ) ; CALL lbc_lnk( bfrva, 'V', 1. ) ! Lateral boundary condition 174 173 175 IF ( ln_isfcav ) THEN 174 176 DO jj = 2, jpjm1 175 177 DO ji = 2, jpim1 176 178 ! (ISF) ======================================================================== 177 ikbu = miku(ji,jj) ! ocean bottomlevel at u- and v-points178 ikbv = mikv(ji,jj) ! ( deepest ocean u- and v-points)179 ikbu = miku(ji,jj) ! ocean top level at u- and v-points 180 ikbv = mikv(ji,jj) ! (1st wet ocean u- and v-points) 179 181 ! 180 182 zvu = 0.25 * ( vn(ji,jj ,ikbu) + vn(ji+1,jj ,ikbu) & … … 183 185 & + un(ji,jj+1,ikbv) + un(ji-1,jj+1,ikbv) ) 184 186 ! 185 zecu = SQRT( un(ji,jj,ikbu) * un(ji,jj,ikbu) + zvu*zvu + rn_ bfeb2 )186 zecv = SQRT( vn(ji,jj,ikbv) * vn(ji,jj,ikbv) + zuv*zuv + rn_ bfeb2 )187 zecu = SQRT( un(ji,jj,ikbu) * un(ji,jj,ikbu) + zvu*zvu + rn_tfeb2 ) 188 zecv = SQRT( vn(ji,jj,ikbv) * vn(ji,jj,ikbv) + zuv*zuv + rn_tfeb2 ) 187 189 ! 188 190 tfrua(ji,jj) = - 0.5_wp * ( ztfrt(ji,jj) + ztfrt(ji+1,jj ) ) * zecu * (1._wp - umask(ji,jj,1)) … … 202 204 END DO 203 205 END DO 204 END IF205 !206 CALL lbc_lnk( bfrua, 'U', 1. ) ; CALL lbc_lnk( bfrva, 'V', 1. ) ! Lateral boundary condition206 CALL lbc_lnk( tfrua, 'U', 1. ) ; CALL lbc_lnk( tfrva, 'V', 1. ) ! Lateral boundary condition 207 END IF 208 ! 207 209 ! 208 210 IF(ln_ctl) CALL prt_ctl( tab2d_1=bfrua, clinfo1=' bfr - u: ', mask1=umask, & … … 277 279 IF(lwp) WRITE(numout,*) ' coef rn_bfri2 enhancement factor rn_bfrien = ',rn_bfrien 278 280 ENDIF 279 IF(lwp) WRITE(numout,*) ' top friction coef. rn_bfri1 = ', rn_bfri1 280 IF( ln_tfr2d ) THEN 281 IF(lwp) WRITE(numout,*) ' read coef. enhancement distribution from file ln_tfr2d = ', ln_tfr2d 282 IF(lwp) WRITE(numout,*) ' coef rn_tfri2 enhancement factor rn_tfrien = ',rn_tfrien 283 ENDIF 281 IF ( ln_isfcav ) THEN 282 IF(lwp) WRITE(numout,*) ' top friction coef. rn_bfri1 = ', rn_tfri1 283 IF( ln_tfr2d ) THEN 284 IF(lwp) WRITE(numout,*) ' read coef. enhancement distribution from file ln_tfr2d = ', ln_tfr2d 285 IF(lwp) WRITE(numout,*) ' coef rn_tfri2 enhancement factor rn_tfrien = ',rn_tfrien 286 ENDIF 287 END IF 284 288 ! 285 289 IF(ln_bfr2d) THEN … … 295 299 bfrua(:,:) = - bfrcoef2d(:,:) 296 300 bfrva(:,:) = - bfrcoef2d(:,:) 301 ! 302 IF ( ln_isfcav ) THEN 303 IF(ln_tfr2d) THEN 304 ! tfr_coef is a coefficient in [0,1] giving the mask where to apply the bfr enhancement 305 CALL iom_open('tfr_coef.nc',inum) 306 CALL iom_get (inum, jpdom_data, 'tfr_coef',tfrcoef2d,1) ! tfrcoef2d is used as tmp array 307 CALL iom_close(inum) 308 tfrcoef2d(:,:) = rn_tfri1 * ( 1 + rn_tfrien * tfrcoef2d(:,:) ) 309 ELSE 310 tfrcoef2d(:,:) = rn_tfri1 ! initialize tfrcoef2d to the namelist variable 311 ENDIF 312 ! 313 tfrua(:,:) = - tfrcoef2d(:,:) 314 tfrva(:,:) = - tfrcoef2d(:,:) 315 END IF 297 316 ! 298 317 CASE( 2 ) … … 311 330 IF(lwp) WRITE(numout,*) ' coef rn_bfri2 enhancement factor rn_bfrien = ',rn_bfrien 312 331 ENDIF 313 IF(lwp) WRITE(numout,*) ' quadratic top friction' 314 IF(lwp) WRITE(numout,*) ' friction coef. rn_bfri2 = ', rn_tfri2 315 IF(lwp) WRITE(numout,*) ' Max. coef. (log case) rn_tfri2_max = ', rn_tfri2_max 316 IF(lwp) WRITE(numout,*) ' background tke rn_tfeb2 = ', rn_tfeb2 317 IF(lwp) WRITE(numout,*) ' log formulation ln_tfr2d = ', ln_loglayer 318 IF(lwp) WRITE(numout,*) ' bottom roughness rn_tfrz0 [m] = ', rn_tfrz0 319 IF( rn_tfrz0<=0.e0 ) THEN 320 WRITE(ctmp1,*) ' bottom roughness must be strictly positive' 321 CALL ctl_stop( ctmp1 ) 322 ENDIF 323 IF( ln_tfr2d ) THEN 324 IF(lwp) WRITE(numout,*) ' read coef. enhancement distribution from file ln_tfr2d = ', ln_tfr2d 325 IF(lwp) WRITE(numout,*) ' coef rn_tfri2 enhancement factor rn_tfrien = ',rn_tfrien 326 ENDIF 332 IF ( ln_isfcav ) THEN 333 IF(lwp) WRITE(numout,*) ' quadratic top friction' 334 IF(lwp) WRITE(numout,*) ' friction coef. rn_tfri2 = ', rn_tfri2 335 IF(lwp) WRITE(numout,*) ' Max. coef. (log case) rn_tfri2_max = ', rn_tfri2_max 336 IF(lwp) WRITE(numout,*) ' background tke rn_tfeb2 = ', rn_tfeb2 337 IF(lwp) WRITE(numout,*) ' log formulation ln_tfr2d = ', ln_loglayer 338 IF(lwp) WRITE(numout,*) ' top roughness rn_tfrz0 [m] = ', rn_tfrz0 339 IF( rn_tfrz0<=0.e0 ) THEN 340 WRITE(ctmp1,*) ' top roughness must be strictly positive' 341 CALL ctl_stop( ctmp1 ) 342 ENDIF 343 IF( ln_tfr2d ) THEN 344 IF(lwp) WRITE(numout,*) ' read coef. enhancement distribution from file ln_tfr2d = ', ln_tfr2d 345 IF(lwp) WRITE(numout,*) ' coef rn_tfri2 enhancement factor rn_tfrien = ',rn_tfrien 346 ENDIF 347 END IF 327 348 ! 328 349 IF(ln_bfr2d) THEN … … 336 357 bfrcoef2d(:,:) = rn_bfri2 ! initialize bfrcoef2d to the namelist variable 337 358 ENDIF 359 360 IF ( ln_isfcav ) THEN 361 IF(ln_tfr2d) THEN 362 ! tfr_coef is a coefficient in [0,1] giving the mask where to apply the bfr enhancement 363 CALL iom_open('tfr_coef.nc',inum) 364 CALL iom_get (inum, jpdom_data, 'tfr_coef',tfrcoef2d,1) ! tfrcoef2d is used as tmp array 365 CALL iom_close(inum) 366 ! 367 tfrcoef2d(:,:) = rn_tfri2 * ( 1 + rn_tfrien * tfrcoef2d(:,:) ) 368 ELSE 369 tfrcoef2d(:,:) = rn_tfri2 ! initialize tfrcoef2d to the namelist variable 370 ENDIF 371 END IF 338 372 ! 339 373 IF ( ln_loglayer.AND.(.NOT.lk_vvl) ) THEN ! set "log layer" bottom friction once for all … … 346 380 END DO 347 381 END DO 382 IF ( ln_isfcav ) THEN 383 DO jj = 1, jpj 384 DO ji = 1, jpi 385 ikbt = mikt(ji,jj) 386 ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_tfrz0 ))**2._wp 387 tfrcoef2d(ji,jj) = MAX(tfrcoef2d(ji,jj), ztmp) 388 tfrcoef2d(ji,jj) = MIN(tfrcoef2d(ji,jj), rn_tfri2_max) 389 END DO 390 END DO 391 END IF 348 392 ENDIF 349 393 ! … … 398 442 zminbfr = MIN( zminbfr, MIN( zfru, ABS( bfrcoef2d(ji,jj) ) ) ) 399 443 zmaxbfr = MAX( zmaxbfr, MIN( zfrv, ABS( bfrcoef2d(ji,jj) ) ) ) 444 ! (ISF) 445 IF ( ln_isfcav ) THEN 446 ikbu = miku(ji,jj) ! 1st wet ocean level at u- and v-points 447 ikbv = mikv(ji,jj) 448 zfru = 0.5 * fse3u(ji,jj,ikbu) / rdt 449 zfrv = 0.5 * fse3v(ji,jj,ikbv) / rdt 450 IF( ABS( tfrcoef2d(ji,jj) ) > zfru ) THEN 451 IF( ln_ctl ) THEN 452 WRITE(numout,*) 'TFR ', narea, nimpp+ji, njmpp+jj, ikbu 453 WRITE(numout,*) 'TFR ', ABS( tfrcoef2d(ji,jj) ), zfru 454 ENDIF 455 ictu = ictu + 1 456 ENDIF 457 IF( ABS( tfrcoef2d(ji,jj) ) > zfrv ) THEN 458 IF( ln_ctl ) THEN 459 WRITE(numout,*) 'TFR ', narea, nimpp+ji, njmpp+jj, ikbv 460 WRITE(numout,*) 'TFR ', tfrcoef2d(ji,jj), zfrv 461 ENDIF 462 ictv = ictv + 1 463 ENDIF 464 zmintfr = MIN( zmintfr, MIN( zfru, ABS( tfrcoef2d(ji,jj) ) ) ) 465 zmaxtfr = MAX( zmaxtfr, MIN( zfrv, ABS( tfrcoef2d(ji,jj) ) ) ) 466 END IF 467 ! END ISF 400 468 END DO 401 469 END DO … … 405 473 CALL mpp_min( zminbfr ) 406 474 CALL mpp_max( zmaxbfr ) 475 IF ( ln_isfcav) CALL mpp_min( zmintfr ) 476 IF ( ln_isfcav) CALL mpp_max( zmaxtfr ) 407 477 ENDIF 408 478 IF( .NOT.ln_bfrimp) THEN 409 479 IF( lwp .AND. ictu + ictv > 0 ) THEN 410 WRITE(numout,*) ' Bottom friction stability check failed at ', ictu, ' U-points '411 WRITE(numout,*) ' Bottom friction stability check failed at ', ictv, ' V-points '480 WRITE(numout,*) ' Bottom/Top friction stability check failed at ', ictu, ' U-points ' 481 WRITE(numout,*) ' Bottom/Top friction stability check failed at ', ictv, ' V-points ' 412 482 WRITE(numout,*) ' Bottom friction coefficient now ranges from: ', zminbfr, ' to ', zmaxbfr 413 WRITE(numout,*) ' Bottomfriction coefficient now ranges from: ', zmintfr, ' to ', zmaxtfr414 WRITE(numout,*) ' Bottom friction coefficient will be reduced where necessary'483 IF ( ln_isfcav ) WRITE(numout,*) ' Top friction coefficient now ranges from: ', zmintfr, ' to ', zmaxtfr 484 WRITE(numout,*) ' Bottom/Top friction coefficient will be reduced where necessary' 415 485 ENDIF 416 486 ENDIF -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r5123 r5350 82 82 USE crsini ! initialise grid coarsening utility 83 83 USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 84 USE stopar 85 USE stopts 84 86 85 87 IMPLICIT NONE … … 432 434 IF( nn_cla == 1 .AND. cp_cfg == 'orca' .AND. jp_cfg == 2 ) CALL cla_init ! Cross Land Advection 433 435 CALL icb_init( rdt, nit000) ! initialise icebergs instance 436 CALL sto_par_init ! Stochastic parametrization 437 IF( ln_sto_eos ) CALL sto_pts_init ! RRandom T/S fluctuations 434 438 435 439 #if defined key_top -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/step.F90
r5120 r5350 106 106 107 107 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 108 ! Update stochastic parameters and random T/S fluctuations 109 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 110 CALL sto_par( kstp ) ! Stochastic parameters 111 112 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 108 113 ! Ocean physics update (ua, va, tsa used as workspace) 109 114 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< … … 145 150 ! 146 151 IF( lk_ldfslp ) THEN ! slope of lateral mixing 152 IF(ln_sto_eos ) CALL sto_pts( tsn ) ! Random T/S fluctuations 147 153 CALL eos( tsb, rhd, gdept_0(:,:,:) ) ! before in situ density 148 154 IF( ln_zps .AND. .NOT. ln_isfcav) & … … 180 186 ! Note that the computation of vertical velocity above, hence "after" sea level 181 187 ! is necessary to compute momentum advection for the rhs of barotropic loop: 188 IF(ln_sto_eos ) CALL sto_pts( tsn ) ! Random T/S fluctuations 182 189 CALL eos ( tsn, rhd, rhop, fsdept_n(:,:,:) ) ! now in situ density for hpg computation 183 190 IF( ln_zps .AND. .NOT. ln_isfcav) & … … 216 223 ! diagnostics and outputs (ua, va, tsa used as workspace) 217 224 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 218 IF( lk_floats ) CALL flo_stp( kstp ) ! drifting Floats 219 IF( lk_diahth ) CALL dia_hth( kstp ) ! Thermocline depth (20 degres isotherm depth) 220 IF( .NOT. lk_cpl ) CALL dia_fwb( kstp ) ! Fresh water budget diagnostics 221 IF( ln_diaptr ) CALL dia_ptr( kstp ) ! Poleward TRansports diagnostics 222 IF( lk_diadct ) CALL dia_dct( kstp ) ! Transports 223 IF( lk_diaar5 ) CALL dia_ar5( kstp ) ! ar5 diag 224 IF( lk_diaharm ) CALL dia_harm( kstp ) ! Tidal harmonic analysis 225 CALL dia_wri( kstp ) ! ocean model: outputs 226 ! 227 IF( ln_crs ) CALL crs_fld( kstp ) ! ocean model: online field coarsening & output 228 225 IF( lk_floats ) CALL flo_stp( kstp ) ! drifting Floats 226 IF( lk_diahth ) CALL dia_hth( kstp ) ! Thermocline depth (20 degres isotherm depth) 227 IF( .NOT. lk_cpl ) CALL dia_fwb( kstp ) ! Fresh water budget diagnostics 228 IF( lk_diadct ) CALL dia_dct( kstp ) ! Transports 229 IF( lk_diaar5 ) CALL dia_ar5( kstp ) ! ar5 diag 230 IF( lk_diaharm ) CALL dia_harm( kstp ) ! Tidal harmonic analysis 231 CALL dia_wri( kstp ) ! ocean model: outputs 232 ! 233 IF( ln_crs ) CALL crs_fld( kstp ) ! ocean model: online field coarsening & output 229 234 230 235 #if defined key_top … … 252 257 IF( lk_zdfkpp ) CALL tra_kpp ( kstp ) ! KPP non-local tracer fluxes 253 258 CALL tra_ldf ( kstp ) ! lateral mixing 259 260 IF( ln_diaptr ) CALL dia_ptr ! Poleward adv/ldf TRansports diagnostics 261 254 262 #if defined key_agrif 255 263 IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_tra ! tracers sponge … … 260 268 IF( ln_zdfnpc ) CALL tra_npc( kstp ) ! update after fields by non-penetrative convection 261 269 CALL tra_nxt( kstp ) ! tracer fields at next time step 270 IF( ln_sto_eos ) CALL sto_pts( tsn ) ! Random T/S fluctuations 262 271 CALL eos ( tsa, rhd, rhop, fsdept_n(:,:,:) ) ! Time-filtered in situ density for hpg computation 263 272 IF( ln_zps .AND. .NOT. ln_isfcav) & … … 270 279 ELSE ! centered hpg (eos then time stepping) 271 280 IF ( .NOT. lk_dynspg_ts ) THEN ! eos already called in time-split case 281 IF( ln_sto_eos ) CALL sto_pts( tsn ) ! Random T/S fluctuations 272 282 CALL eos ( tsn, rhd, rhop, fsdept_n(:,:,:) ) ! now in situ density for hpg computation 273 283 IF( ln_zps .AND. .NOT. ln_isfcav) & … … 338 348 CALL iom_close( numror ) ! close input ocean restart file 339 349 IF(lwm) CALL FLUSH ( numond ) ! flush output namelist oce 340 IF( lwm.AND.numoni /= -1 ) CALL FLUSH ( numoni ) ! flush output namelist ice 350 IF( lwm.AND.numoni /= -1 ) CALL FLUSH ( numoni ) ! flush output namelist ice 341 351 ENDIF 342 352 IF( lrst_oce ) CALL rst_write ( kstp ) ! write output ocean restart file -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
r4990 r5350 53 53 54 54 USE dynnxt ! time-stepping (dyn_nxt routine) 55 56 USE stopar ! Stochastic parametrization (sto_par routine) 57 USE stopts 55 58 56 59 USE bdy_par ! for lk_bdy -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/wrk_nemo.F90
- Property svn:keywords set to Id
r3294 r5350 123 123 !!---------------------------------------------------------------------- 124 124 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 125 !! $Id :$125 !! $Id$ 126 126 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 127 127 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/SAS_SRC/daymod.F90
- Property svn:keywords set to Id
r4162 r5350 45 45 !!---------------------------------------------------------------------- 46 46 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 47 !! $Id : daymod.F90 3294 2012-01-28 16:44:18Z rblod$47 !! $Id$ 48 48 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 49 49 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/SAS_SRC/diawri.F90
- Property svn:keywords set to Id
r4292 r5350 70 70 !!---------------------------------------------------------------------- 71 71 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 72 !! $Id 72 !! $Id$ 73 73 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 74 74 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90
- Property svn:keywords set to Id
r5120 r5350 66 66 !!---------------------------------------------------------------------- 67 67 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 68 !! $Id : nemogcm.F90 3294 2012-01-28 16:44:18Z rblod$68 !! $Id$ 69 69 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 70 70 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90
- Property svn:keywords set to Id
r4990 r5350 57 57 !!---------------------------------------------------------------------- 58 58 !! NEMO/OFF 3.3 , NEMO Consortium (2010) 59 !! $Id : sbcssm.F90 3294 2012-01-28 16:44:18Z rblod$59 !! $Id$ 60 60 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 61 61 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/SAS_SRC/step.F90
- Property svn:keywords set to Id
r4166 r5350 46 46 !!---------------------------------------------------------------------- 47 47 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 48 !! $Id : step.F90 3294 2012-01-28 16:44:18Z rblod$48 !! $Id$ 49 49 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 50 50 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/SAS_SRC/stpctl.F90
- Property svn:keywords set to Id
r3358 r5350 28 28 !!---------------------------------------------------------------------- 29 29 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 30 !! $Id : stpctl.F90 3294 2012-01-28 16:44:18Z rblod$30 !! $Id$ 31 31 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 32 32 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90
r4996 r5350 54 54 !!---------------------------------------------------------------------- 55 55 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 56 !! $ Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/SMS/trcc14bomb.F90,v 1.2 2005/11/14 16:42:43 opalod Exp$56 !! $Id$ 57 57 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 58 58 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90
- Property svn:keywords set to Id
r4996 r5350 63 63 !!---------------------------------------------------------------------- 64 64 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 65 !! $Id : p2zbio.F90 3294 2012-01-28 16:44:18Z rblod$65 !! $Id$ 66 66 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 67 67 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90
- Property svn:keywords set to Id
r4996 r5350 45 45 !!---------------------------------------------------------------------- 46 46 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 47 !! $Id : trcexp.F90 3294 2012-01-28 16:44:18Z rblod$47 !! $Id$ 48 48 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 49 49 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90
- Property svn:keywords set to Id
r4990 r5350 44 44 !!---------------------------------------------------------------------- 45 45 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 46 !! $Id : trcopt.F90 3294 2012-01-28 16:44:18Z rblod$46 !! $Id$ 47 47 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 48 48 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90
- Property svn:keywords set to Id
r4996 r5350 38 38 !!---------------------------------------------------------------------- 39 39 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 40 !! $Id : p2z_sed.F90 3294 2012-01-28 16:44:18Z rblod$40 !! $Id$ 41 41 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 42 42 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsms.F90
- Property svn:keywords set to Id
r4990 r5350 32 32 !!---------------------------------------------------------------------- 33 33 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 34 !! $Id : p2zsms.F90 3294 2012-01-28 16:44:18Z rblod$34 !! $Id$ 35 35 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 36 36 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90
- Property svn:keywords set to Id
r3557 r5350 168 168 !!---------------------------------------------------------------------- 169 169 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 170 !! $Id : p4zche.F90 3294 2012-01-28 16:44:18Z rblod$170 !! $Id$ 171 171 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 172 172 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90
- Property svn:keywords set to Id
r4996 r5350 63 63 !!---------------------------------------------------------------------- 64 64 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 65 !! $Id : p4zflx.F90 3294 2012-01-28 16:44:18Z rblod$65 !! $Id$ 66 66 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 67 67 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90
- Property svn:keywords set to Id
r3446 r5350 26 26 !!---------------------------------------------------------------------- 27 27 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 28 !! $Id : p4zint.F90 3294 2012-01-28 16:44:18Z rblod$28 !! $Id$ 29 29 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 30 30 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90
- Property svn:keywords set to Id
r4624 r5350 39 39 !!---------------------------------------------------------------------- 40 40 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 41 !! $Id : p4zmort.F90 3160 2011-11-20 14:27:18Z cetlod$41 !! $Id$ 42 42 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 43 43 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90
- Property svn:keywords set to Id
r4996 r5350 85 85 !!---------------------------------------------------------------------- 86 86 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 87 !! $ Header:$87 !! $Id$ 88 88 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 89 89 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90
- Property svn:keywords set to Id
r4996 r5350 42 42 !!---------------------------------------------------------------------- 43 43 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 44 !! $ Header:$44 !! $Id$ 45 45 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 46 46 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/par_sed.F90
- Property svn:keywords set to Id
r3443 r5350 7 7 !! ! 06-12 (C. Ethe) Orignal 8 8 !!---------------------------------------------------------------------- 9 !! $Id$ 9 10 #if defined key_sed 10 11 !! Domain characteristics -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sed.F90
- Property svn:keywords set to Id
r4292 r5350 160 160 INTEGER, PUBLIC :: numsed = 27 ! units 161 161 162 !! $Id$ 162 163 CONTAINS 163 164 -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedadv.F90
- Property svn:keywords set to Id
r3443 r5350 23 23 REAL(wp) :: eps = 1.e-13 24 24 25 !! $Id$ 25 26 CONTAINS 26 27 … … 438 439 !! MODULE sedbtb : Dummy module 439 440 !!====================================================================== 441 !! $Id$ 440 442 CONTAINS 441 443 SUBROUTINE sed_adv( kt ) ! Empty routine -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedarr.F90
- Property svn:keywords set to Id
r3443 r5350 29 29 !!---------------------------------------------------------------------- 30 30 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 31 !! $ Header: /home/opalod/NEMOCVSROOT/NEMO/LIM_SRC/limtab.F90,v 1.2 2005/03/27 18:34:42 opalod Exp$31 !! $Id$ 32 32 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 33 33 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedbtb.F90
- Property svn:keywords set to Id
r3443 r5350 12 12 13 13 14 !! $Id$ 14 15 CONTAINS 15 16 … … 77 78 !! MODULE sedbtb : Dummy module 78 79 !!====================================================================== 80 !! $Id$ 79 81 CONTAINS 80 82 SUBROUTINE sed_btb( kt ) ! Empty routine -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedchem.F90
- Property svn:keywords set to Id
r3443 r5350 163 163 DATA Ddsw / 999.842594 , 6.793952E-2 , -9.095290E-3, 1.001685E-4, -1.120083E-6, 6.536332E-9/ 164 164 165 !! $Id$ 165 166 CONTAINS 166 167 … … 559 560 !! MODULE sedchem : Dummy module 560 561 !!====================================================================== 562 !! $Id$ 561 563 CONTAINS 562 564 SUBROUTINE sed_chem( kt ) ! Empty routine -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedco3.F90
- Property svn:keywords set to Id
r3443 r5350 23 23 !!---------------------------------------------------------------------- 24 24 25 !! $Id$ 25 26 CONTAINS 26 27 … … 188 189 !! MODULE sedco3 : Dummy module 189 190 !!====================================================================== 191 !! $Id$ 190 192 CONTAINS 191 193 SUBROUTINE sed_co3( kt ) ! Empty routine -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/seddsr.F90
- Property svn:keywords set to Id
r3443 r5350 20 20 REAL(wp), DIMENSION(:), ALLOCATABLE, PUBLIC :: dens_mol_wgt ! molecular density 21 21 22 !! $Id$ 22 23 CONTAINS 23 24 … … 530 531 !! MODULE seddsr : Dummy module 531 532 !!====================================================================== 533 !! $Id$ 532 534 CONTAINS 533 535 SUBROUTINE sed_dsr ( kt ) -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/seddta.F90
- Property svn:keywords set to Id
r3443 r5350 28 28 #endif 29 29 30 !! $Id$ 30 31 CONTAINS 31 32 … … 268 269 !! MODULE seddta : Dummy module 269 270 !!====================================================================== 271 !! $Id$ 270 272 CONTAINS 271 273 SUBROUTINE sed_dta ( kt ) -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedini.F90
- Property svn:keywords set to Id
r4292 r5350 55 55 PUBLIC sed_init ! routine called by opa.F90 56 56 57 !! $Id$ 57 58 CONTAINS 58 59 … … 856 857 !! Dummy module : NO Sediment model 857 858 !!---------------------------------------------------------------------- 859 !! $Id$ 858 860 CONTAINS 859 861 SUBROUTINE sed_ini ! Empty routine -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmat.F90
- Property svn:keywords set to Id
r3443 r5350 22 22 23 23 24 !! $Id$ 24 25 CONTAINS 25 26 … … 257 258 !! MODULE sedmat : Dummy module 258 259 !!====================================================================== 260 !! $Id$ 259 261 CONTAINS 260 262 SUBROUTINE sed_mat ! Empty routine -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmbc.F90
- Property svn:keywords set to Id
r3443 r5350 36 36 REAL(wp) :: src13ca 37 37 38 !! $Id$ 38 39 CONTAINS 39 40 … … 311 312 !! MODULE sedmbc : Dummy module 312 313 !!====================================================================== 314 !! $Id$ 313 315 CONTAINS 314 316 SUBROUTINE sed_mbc( kt ) ! Empty routine -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmodel.F90
- Property svn:keywords set to Id
r3443 r5350 17 17 LOGICAL, PUBLIC, PARAMETER :: lk_sed = .TRUE. !: sediment flag 18 18 19 !! $Id$ 19 20 CONTAINS 20 21 … … 47 48 !!====================================================================== 48 49 LOGICAL, PUBLIC, PARAMETER :: lk_sed = .FALSE. !: sediment flag 50 !! $Id$ 49 51 CONTAINS 50 52 SUBROUTINE sed_model( kt ) ! Empty routine -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedrst.F90
- Property svn:keywords set to Id
r3443 r5350 25 25 26 26 27 !! $Id$ 27 28 CONTAINS 28 29 … … 270 271 !! MODULE sedrst : Dummy module 271 272 !!====================================================================== 273 !! $Id$ 272 274 CONTAINS 273 275 SUBROUTINE sed_rst_read ! Empty routines -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedsfc.F90
- Property svn:keywords set to Id
r3443 r5350 12 12 PUBLIC sed_sfc 13 13 14 !! $Id$ 14 15 CONTAINS 15 16 … … 67 68 !! MODULE sedsfc : Dummy module 68 69 !!====================================================================== 70 !! $Id$ 69 71 CONTAINS 70 72 SUBROUTINE sed_sfc ( kt ) -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedstp.F90
- Property svn:keywords set to Id
r3443 r5350 23 23 PUBLIC sed_stp ! called by step.F90 24 24 25 !! $Id$ 25 26 CONTAINS 26 27 … … 69 70 !! MODULE sedstp : Dummy module 70 71 !!====================================================================== 72 !! $Id$ 71 73 CONTAINS 72 74 SUBROUTINE sed_stp( kt ) ! Empty routine -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedwri.F90
- Property svn:keywords set to Id
r3443 r5350 25 25 INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndext51 26 26 27 !! $Id$ 27 28 CONTAINS 28 29 … … 264 265 !! MODULE sedwri : Dummy module 265 266 !!====================================================================== 267 !! $Id$ 266 268 CONTAINS 267 269 SUBROUTINE sed_wri( kt ) ! Empty routine -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90
r5102 r5350 43 43 !!---------------------------------------------------------------------- 44 44 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 45 !! $ Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/TRP/trcdmp.F90,v 1.11 2006/09/01 14:03:49 opalod Exp$45 !! $Id$ 46 46 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 47 47 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc.F90
- Property svn:keywords set to Id
r4990 r5350 71 71 !!---------------------------------------------------------------------- 72 72 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 73 !! $ Header:$73 !! $Id$ 74 74 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 75 75 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc_rst.F90
- Property svn:keywords set to Id
r4990 r5350 23 23 !!--------------------------------------------------------------------------------- 24 24 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 25 !! $ Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/TRD/trdmxl_rst.F90,v 1.6 2006/11/14 09:46:13 opalod Exp$25 !! $Id$ 26 26 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 27 27 !!--------------------------------------------------------------------------------- … … 39 39 ! 40 40 CHARACTER(LEN=20) :: clkt ! ocean time-step deine as a character 41 CHARACTER(LEN=50) :: clname ! ice output restart file name 41 CHARACTER(LEN=50) :: clname ! output restart file name 42 CHARACTER(LEN=256) :: clpath ! full path to restart file 42 43 CHARACTER (len=35) :: charout 43 44 INTEGER :: jl, jk, jn ! loop indice … … 51 52 ENDIF 52 53 clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_trdrst_trc_out) 53 IF(lwp) WRITE(numout,*) ' open ocean restart_mld_trc NetCDF '//clname 54 CALL iom_open( clname, nummldw_trc, ldwrt = .TRUE., kiolib = jprstlib ) 54 clpath = TRIM(cn_trcrst_outdir) 55 IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 56 IF(lwp) WRITE(numout,*) ' open ocean restart_mld_trc NetCDF 'TRIM(clpath)//TRIM(clname) 57 CALL iom_open( TRIM(clpath)//TRIM(clname), nummldw_trc, ldwrt = .TRUE., kiolib = jprstlib ) 55 58 ENDIF 56 59 … … 133 136 INTEGER :: jlibalt = jprstlib 134 137 LOGICAL :: llok 138 CHARACTER(LEN=256) :: clpath ! full path to restart file 135 139 !!----------------------------------------------------------------------------- 136 140 … … 141 145 ENDIF 142 146 147 clpath = TRIM(cn_trcrst_indir) 148 IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 149 143 150 IF ( jprstlib == jprstdimg ) THEN 144 151 ! eventually read netcdf file (monobloc) for restarting on different number of processors 145 152 ! if {cn_trdrst_trc_in}.nc exists, then set jlibalt to jpnf90 146 INQUIRE( FILE = TRIM(c n_trdrst_trc_in)//'.nc', EXIST = llok )153 INQUIRE( FILE = TRIM(clpath)//TRIM(cn_trdrst_trc_in)//'.nc', EXIST = llok ) 147 154 IF ( llok ) THEN ; jlibalt = jpnf90 ; ELSE ; jlibalt = jprstlib ; ENDIF 148 155 ENDIF 149 156 150 CALL iom_open( cn_trdrst_trc_in, inum, kiolib = jlibalt )157 CALL iom_open( TRIM(clpath)//TRIM(cn_trdrst_trc_in), inum, kiolib = jlibalt ) 151 158 152 159 IF( ln_trdmxl_trc_instant ) THEN -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc.F90
- Property svn:keywords set to Id
r4990 r5350 33 33 !!---------------------------------------------------------------------- 34 34 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 35 !! $ Header:$35 !! $Id$ 36 36 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 37 37 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc_oce.F90
- Property svn:keywords set to Id
r4990 r5350 118 118 !!---------------------------------------------------------------------- 119 119 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 120 !! $ Header: /home/opalod/NEMOCVSROOT/NEMO/OPA_SRC/TRD/trdmxl_oce.F90,v 1.2 2005/03/27 18:35:23 opalod Exp$120 !! $Id$ 121 121 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 122 122 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/trc.F90
r4990 r5350 54 54 INTEGER , PUBLIC :: nn_rsttr !: control of the time step ( 0 or 1 ) for pass. tr. 55 55 CHARACTER(len = 80) , PUBLIC :: cn_trcrst_in !: suffix of pass. tracer restart name (input) 56 CHARACTER(len = 256), PUBLIC :: cn_trcrst_indir !: restart input directory 56 57 CHARACTER(len = 80) , PUBLIC :: cn_trcrst_out !: suffix of pass. tracer restart name (output) 58 CHARACTER(len = 256), PUBLIC :: cn_trcrst_outdir !: restart output directory 57 59 REAL(wp) , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: rdttrc !: vertical profile of passive tracer time step 58 60 LOGICAL , PUBLIC :: ln_top_euler !: boolean term for euler integration … … 172 174 !!---------------------------------------------------------------------- 173 175 !! NEMO/TOP 3.3.1 , NEMO Consortium (2010) 174 !! $Id$ 176 !! $Id$ 175 177 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 176 178 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/trcbc.F90
- Property svn:keywords set to Id
r4624 r5350 44 44 !!---------------------------------------------------------------------- 45 45 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 46 !! $Id : trcdta.F90 2977 2011-10-22 13:46:41Z cetlod$46 !! $Id$ 47 47 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 48 48 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/trcnam.F90
r4990 r5350 39 39 !!---------------------------------------------------------------------- 40 40 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 41 !! $Id$ 41 !! $Id$ 42 42 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 43 43 !!---------------------------------------------------------------------- … … 175 175 !!--------------------------------------------------------------------- 176 176 NAMELIST/namtrc_run/ nn_dttrc, nn_writetrc, ln_rsttr, nn_rsttr, ln_top_euler, & 177 & cn_trcrst_in, cn_trcrst_out 177 & cn_trcrst_indir, cn_trcrst_outdir, cn_trcrst_in, cn_trcrst_out 178 178 179 179 180 INTEGER :: ios ! Local integer output status for namelist read … … 339 340 !!---------------------------------------------------------------------- 340 341 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 341 !! $Id$ 342 !! $Id$ 342 343 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 343 344 !!====================================================================== -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
r4990 r5350 51 51 CHARACTER(LEN=20) :: clkt ! ocean time-step define as a character 52 52 CHARACTER(LEN=50) :: clname ! trc output restart file name 53 CHARACTER(LEN=256) :: clpath ! full path to ocean output restart file 53 54 !!---------------------------------------------------------------------- 54 55 ! … … 56 57 IF( kt == nittrc000 ) THEN 57 58 lrst_trc = .FALSE. 58 nitrst = nitend 59 ENDIF 60 61 IF( MOD( kt - 1, nstock ) == 0 ) THEN 59 IF( ln_rst_list ) THEN 60 nrst_lst = 1 61 nitrst = nstocklist( nrst_lst ) 62 ELSE 63 nitrst = nitend 64 ENDIF 65 ENDIF 66 67 IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN 62 68 ! we use kt - 1 and not kt - nittrc000 to keep the same periodicity from the beginning of the experiment 63 69 nitrst = kt + nstock - 1 ! define the next value of nitrst for restart writing … … 79 85 IF(lwp) WRITE(numout,*) 80 86 clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_trcrst_out) 81 IF(lwp) WRITE(numout,*) ' open trc restart.output NetCDF file: '//clname 82 CALL iom_open( clname, numrtw, ldwrt = .TRUE., kiolib = jprstlib ) 87 clpath = TRIM(cn_trcrst_outdir) 88 IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 89 IF(lwp) WRITE(numout,*) & 90 ' open trc restart.output NetCDF file: ',TRIM(clpath)//clname 91 CALL iom_open( TRIM(clpath)//TRIM(clname), numrtw, ldwrt = .TRUE., kiolib = jprstlib ) 83 92 lrst_trc = .TRUE. 84 93 ENDIF … … 140 149 lrst_trc = .FALSE. 141 150 #endif 151 IF( lk_offline .AND. ln_rst_list ) THEN 152 nrst_lst = nrst_lst + 1 153 nitrst = nstocklist( nrst_lst ) 154 ENDIF 142 155 ENDIF 143 156 ! … … 190 203 ! eventually read netcdf file (monobloc) for restarting on different number of processors 191 204 ! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90 192 INQUIRE( FILE = TRIM(cn_trcrst_in )//'.nc', EXIST = llok )205 INQUIRE( FILE = TRIM(cn_trcrst_indir)//'/'//TRIM(cn_trcrst_in)//'.nc', EXIST = llok ) 193 206 IF ( llok ) THEN ; jlibalt = jpnf90 ; ELSE ; jlibalt = jprstlib ; ENDIF 194 207 ENDIF 195 208 196 CALL iom_open( cn_trcrst_in, numrtr, kiolib = jlibalt )209 CALL iom_open( TRIM(cn_trcrst_indir)//'/'//cn_trcrst_in, numrtr, kiolib = jlibalt ) 197 210 198 211 CALL iom_get ( numrtr, 'kt', zkt ) ! last time-step of previous run … … 306 319 !!---------------------------------------------------------------------- 307 320 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 308 !! $Id$ 321 !! $Id$ 309 322 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 310 323 !!====================================================================== -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/TOP_SRC/trcsub.F90
- Property svn:keywords set to Id
r4611 r5350 48 48 !!---------------------------------------------------------------------- 49 49 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 50 !! $Id : trcstp.F90 2528 2010-12-27 17:33:53Z rblod$50 !! $Id$ 51 51 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 52 52 !!---------------------------------------------------------------------- -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/SETTE/BATCH_TEMPLATE/batch-IBM_EKMAN_INGV
r4277 r5350 2 2 #! 3 3 #BSUB -q long 4 #BSUB -n NPROCS4 #BSUB -n TOTAL_NPROCS 5 5 #BSUB -J MPI_config 6 6 #BSUB -o stdout.%J … … 14 14 # 15 15 OCEANCORES=NPROCS 16 XIOS_NUMPROCS=NXIOPROCS 16 17 export SETTE_DIR=DEF_SETTE_DIR 17 18 … … 23 24 # 24 25 26 MPIPROGINF=detail 27 export MPIPROGINF 28 export LSF_PJL_TYPE="intelmpi" 29 export MP_PGMMODEL=mpmd 30 export MP_SHARED_MEMORY=yes 25 31 export MPIRUN="mpirun -n $OCEANCORES" 26 27 #export MPIRUN="mpirun -np" 32 export MPIRUN_MPMD="mpirun -np $OCEANCORES ./opa : -np $XIOS_NUMPROCS /home/delrosso/XIOS_1.0/xios-1.0/bin/xios_server.exe" 28 33 29 34 # … … 67 72 68 73 if [ MPI_FLAG == "yes" ]; then 69 time ${MPIRUN} ./opa 74 if [ $XIOS_NUMPROCS -eq 0 ]; then 75 time ${MPIRUN} ./opa 76 else 77 time ${MPIRUN_MPMD} 78 fi 70 79 else 71 time ./opa80 time ./opa 72 81 fi 73 82 # -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/SETTE/sette.sh
r4990 r5350 1000 1000 export TEST_NAME="LONG" 1001 1001 cd ${CONFIG_DIR} 1002 . ./makenemo -m ${CMP_NAM} -n ISOMIP_LONG - rISOMIP -j 8 del_key ${DEL_KEYS}1002 . ./makenemo -m ${CMP_NAM} -n ISOMIP_LONG -u ISOMIP -j 8 del_key ${DEL_KEYS} 1003 1003 cd ${SETTE_DIR} 1004 1004 . ./param.cfg … … 1068 1068 export TEST_NAME="REPRO_1_4" 1069 1069 cd ${CONFIG_DIR} 1070 . ./makenemo -m ${CMP_NAM} -n ISOMIP_4 - rISOMIP -j 8 add_key "key_mpp_rep" del_key ${DEL_KEYS}1070 . ./makenemo -m ${CMP_NAM} -n ISOMIP_4 -u ISOMIP -j 8 add_key "key_mpp_rep" del_key ${DEL_KEYS} 1071 1071 cd ${SETTE_DIR} 1072 1072 . ./param.cfg -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/TOOLS/MISCELLANEOUS/chk_wrk_alloc.sh
r3294 r5350 12 12 # ../TOOLS/MISCELLANEOUS/chk_wrk_alloc.sh 13 13 # 14 set -u e14 set -u 15 15 # 16 16 echo "check for all *90 files contained in "$( pwd )" and its subdirectories" 17 17 # 18 for ff in $( grep -il wrk_nemo_2 $( find . -name "*90" ) )18 for ff in $( grep -il "^ *use *wrk_nemo" $( find . -name "*90" ) $( find . -name "*h90" ) ) 19 19 do 20 21 20 # number of lines with wrk_alloc 22 n1=$( grep -ic "call *wrk_alloc *(" $ff ) 23 # replace wrk_alloc with wrk_dealloc and count the lines 24 n2=$( sed -e "s/wrk_alloc/wrk_dealloc/" $ff | grep -ic "call *wrk_dealloc *(" ) 25 # we should get n2 = 2 * n1... 26 [ $(( 2 * $n1 )) -ne $n2 ] && echo "problem with wrk_alloc in $ff" 27 28 # same story but for wrk_dealloc 29 n1=$( grep -ic "call *wrk_dealloc *(" $ff ) 30 n2=$( sed -e "s/wrk_dealloc/wrk_alloc/" $ff | grep -ic "call *wrk_alloc *(" ) 31 [ $(( 2 * $n1 )) -ne $n2 ] && echo "problem with wrk_dealloc in $ff" 32 21 n1=$( grep -ic "call *wrk_alloc *(" $ff ) 22 # number of lines with wrk_dealloc 23 nn1=$( grep -ic "call *wrk_dealloc *(" $ff ) 24 25 if [ $(( $n1 + $nn1 )) -ne 0 ] 26 then 27 # replace wrk_alloc with wrk_dealloc and count the lines 28 n2=$( sed -e "s/wrk_alloc/wrk_dealloc/" $ff | grep -ic "call *wrk_dealloc *(" ) 29 # we should get n2 = 2 * n1... 30 [ $(( 2 * $n1 )) -ne $n2 ] && echo "problem with wrk_alloc in $ff" 31 32 # same story but for wrk_dealloc 33 nn2=$( sed -e "s/wrk_dealloc/wrk_alloc/" $ff | grep -ic "call *wrk_alloc *(" ) 34 [ $(( 2 * $nn1 )) -ne $nn2 ] && echo "problem with wrk_dealloc in $ff" 35 fi 36 33 37 done -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/fcm-make/inc/keys-amm12.cfg
r4204 r5350 1 1 preprocess.prop{fpp.defs} = \ 2 key_bdy key_tide key_ vectopt_loop key_amm_12km key_dynspg_ts key_ldfslp key_zdfgls key_vvl key_diainstant key_mpp_mpi key_iomput2 key_bdy key_tide key_dynspg_ts key_ldfslp key_zdfgls key_vvl key_diainstant key_mpp_mpi key_iomput -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/fcm-make/inc/keys-gyre.cfg
r4204 r5350 1 1 preprocess.prop{fpp.defs} = \ 2 key_ gyre key_dynspg_flt key_ldfslp key_zdftke key_iomput key_mpp_mpi2 key_dynspg_flt key_ldfslp key_zdftke key_iomput key_mpp_mpi key_nosignedzero -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/fcm-make/inc/keys-gyre_pisces.cfg
r4204 r5350 1 1 preprocess.prop{fpp.defs} = \ 2 key_ gyre key_dynspg_flt key_ldfslp key_zdftke key_top key_pisces_reduced key_iomput key_mpp_mpi2 key_dynspg_flt key_ldfslp key_zdftke key_top key_pisces_reduced key_iomput key_mpp_mpi -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/fcm-make/inc/keys-orca2_lim.cfg
r4204 r5350 1 1 preprocess.prop{fpp.defs} = \ 2 key_trabbl key_ orca_r2 key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi2 key_trabbl key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_iomput key_mpp_mpi key_diaobs key_asminc -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/fcm-make/inc/keys-orca2_lim_cfc.cfg
r4204 r5350 1 1 preprocess.prop{fpp.defs} = \ 2 key_trabbl key_ orca_r2 key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_top key_cfc key_c14b key_iomput key_mpp_mpi2 key_trabbl key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_top key_cfc key_c14b key_iomput key_mpp_mpi -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/fcm-make/inc/keys-orca2_lim_pisces.cfg
r4204 r5350 1 1 preprocess.prop{fpp.defs} = \ 2 key_trabbl key_ orca_r2 key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_top key_pisces key_iomput key_mpp_mpi2 key_trabbl key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_zdftke key_zdfddm key_zdftmx key_top key_pisces key_iomput key_mpp_mpi -
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/fcm-make/inc/keys-orca2_off_pisces.cfg
r4204 r5350 1 1 preprocess.prop{fpp.defs} = \ 2 key_trabbl key_ orca_r2 key_ldfslp key_traldf_c2d key_traldf_eiv key_top key_offline key_pisces key_iomput key_mpp_mpi2 key_trabbl key_ldfslp key_traldf_c2d key_traldf_eiv key_top key_offline key_pisces key_iomput key_mpp_mpi
Note: See TracChangeset
for help on using the changeset viewer.