Changeset 15480 for NEMO/branches
- Timestamp:
- 2021-11-08T15:51:42+01:00 (3 years ago)
- Location:
- NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem
- Files:
-
- 324 added
- 51 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/ADM/DOC_SCRIPTS/extract_rst.sh
r8058 r15480 109 109 # ========== 110 110 # 111 # $Id : extract_rst.sh 2246 2010-10-13 09:47:23Z rblod$111 # $Id$ 112 112 # 113 113 # - fplod 2009-04-20T08:13:37Z aedon.locean-ipsl.upmc.fr (Darwin) -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/ADM/DOC_SCRIPTS/install.sh
r8058 r15480 47 47 # ========== 48 48 # 49 # $Id : install.sh 2246 2010-10-13 09:47:23Z rblod$49 # $Id$ 50 50 # 51 51 # - fplod 2008-09-16T15:24:26Z aedon.locean-ipsl.upmc.fr (Darwin) -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/ADM/DOC_SCRIPTS/makefile_compile
r8058 r15480 21 21 # ========== 22 22 # 23 # $Id : makefile_compile 2520 2010-12-27 14:43:36Z rblod$23 # $Id$ 24 24 # 25 25 # - fplod 20100419T145702Z aedon.locean-ipsl.upmc.fr (Darwin) -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/CONFIG/C1D_PAPA/cpp_C1D_PAPA.fcm
r4667 r15480 1 bld::tool::fppkeys key_c1d key_zdfgls 1 bld::tool::fppkeys key_c1d key_zdfgls key_nosignedzero -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/CONFIG/SHARED/namelist_ref
r10728 r15480 1174 1174 / 1175 1175 !----------------------------------------------------------------------- 1176 &nam_diatmb ! Output Top, Middle, Bottom Diagnostics 1177 !----------------------------------------------------------------------- 1178 ln_diatmb = .false. 1179 / 1180 !----------------------------------------------------------------------- 1181 &nam_dia25h ! Output 25 hour mean diagnostics 1182 !----------------------------------------------------------------------- 1183 ln_dia25h = .true. 1184 / 1185 !----------------------------------------------------------------------- 1176 1186 &namdct ! transports through sections 1177 1187 !----------------------------------------------------------------------- … … 1196 1206 ln_s3d = .false. ! Logical switch for S profile observations 1197 1207 ln_ena = .false. ! Logical switch for ENACT insitu data set 1198 ! ! ln_corLogical switch for Coriolis insitu data set1208 ln_cor = .false. ! Logical switch for Coriolis insitu data set 1199 1209 ln_profb = .false. ! Logical switch for feedback insitu data set 1200 1210 ln_sla = .false. ! Logical switch for SLA observations 1201 1202 1211 ln_sladt = .false. ! Logical switch for AVISO SLA data 1203 1204 1212 ln_slafb = .false. ! Logical switch for feedback SLA data 1205 ! ln_ssh Logical switch for SSH observations 1206 1207 ln_sst = .false. ! Logical switch for SST observations 1208 ln_reysst = .false. ! ln_reysst Logical switch for Reynolds observations 1209 ln_ghrsst = .false. ! ln_ghrsst Logical switch for GHRSST observations 1210 1213 ln_ssh = .false. ! Logical switch for SSH observations 1214 ln_sst = .false. ! Logical switch for SST observations 1215 ln_reysst = .false. ! Logical switch for Reynolds observations 1216 ln_ghrsst = .false. ! Logical switch for GHRSST observations 1211 1217 ln_sstfb = .false. ! Logical switch for feedback SST data 1212 ! ln_sssLogical switch for SSS observations1218 ln_sss = .false. ! Logical switch for SSS observations 1213 1219 ln_seaice = .false. ! Logical switch for Sea Ice observations 1214 ! ln_vel3d Logical switch for velocity observations 1215 ! ln_velavcur Logical switch for velocity daily av. cur. 1216 ! ln_velhrcur Logical switch for velocity high freq. cur. 1217 ! ln_velavadcp Logical switch for velocity daily av. ADCP 1218 ! ln_velhradcp Logical switch for velocity high freq. ADCP 1219 ! ln_velfb Logical switch for feedback velocity data 1220 ! ln_grid_global Global distribtion of observations 1221 ! ln_grid_search_lookup Logical switch for obs grid search w/lookup table 1222 ! grid_search_file Grid search lookup file header 1223 ! enactfiles ENACT input observation file names 1224 ! coriofiles Coriolis input observation file name 1225 ! ! profbfiles: Profile feedback input observation file name 1226 profbfiles = 'profiles_01.nc' 1227 ! ln_profb_enatim Enact feedback input time setting switch 1228 ! slafilesact Active SLA input observation file name 1229 ! slafilespas Passive SLA input observation file name 1230 ! ! slafbfiles: Feedback SLA input observation file name 1231 slafbfiles = 'sla_01.nc' 1232 ! sstfiles GHRSST input observation file name 1233 ! ! sstfbfiles: Feedback SST input observation file name 1234 sstfbfiles = 'sst_01.nc' 1235 ! seaicefiles Sea Ice input observation file names 1236 seaicefiles = 'seaice_01.nc' 1237 ! velavcurfiles Vel. cur. daily av. input file name 1238 ! velhvcurfiles Vel. cur. high freq. input file name 1239 ! velavadcpfiles Vel. ADCP daily av. input file name 1240 ! velhvadcpfiles Vel. ADCP high freq. input file name 1241 ! velfbfiles Vel. feedback input observation file name 1242 ! dobsini Initial date in window YYYYMMDD.HHMMSS 1243 ! dobsend Final date in window YYYYMMDD.HHMMSS 1244 ! n1dint Type of vertical interpolation method 1245 ! n2dint Type of horizontal interpolation method 1246 ! ln_nea Rejection of observations near land switch 1247 nmsshc = 0 ! MSSH correction scheme 1248 ! mdtcorr MDT correction 1249 ! mdtcutoff MDT cutoff for computed correction 1220 ln_vel3d = .false. ! Logical switch for velocity observations 1221 ln_velavcur= .false ! Logical switch for velocity daily av. cur. 1222 ln_velhrcur= .false ! Logical switch for velocity high freq. cur. 1223 ln_velavadcp = .false. ! Logical switch for velocity daily av. ADCP 1224 ln_velhradcp = .false. ! Logical switch for velocity high freq. ADCP 1225 ln_velfb = .false. ! Logical switch for feedback velocity data 1226 ln_grid_global = .false. ! Global distribtion of observations 1227 ln_grid_search_lookup = .false. ! Logical switch for obs grid search w/lookup table 1228 grid_search_file = 'grid_search' ! Grid search lookup file header 1229 ! All of the *files* variables below are arrays. Use namelist_cfg to add more files 1230 enactfiles = 'enact.nc' ! ENACT input observation file names (specify full array in namelist_cfg) 1231 coriofiles = 'corio.nc' ! Coriolis input observation file name 1232 profbfiles = 'profiles_01.nc' ! Profile feedback input observation file name 1233 ln_profb_enatim = .false ! Enact feedback input time setting switch 1234 slafilesact = 'sla_act.nc' ! Active SLA input observation file names 1235 slafilespas = 'sla_pass.nc' ! Passive SLA input observation file names 1236 slafbfiles = 'sla_01.nc' ! slafbfiles: Feedback SLA input observation file names 1237 sstfiles = 'ghrsst.nc' ! GHRSST input observation file names 1238 sstfbfiles = 'sst_01.nc' ! Feedback SST input observation file names 1239 seaicefiles = 'seaice_01.nc' ! Sea Ice input observation file names 1240 velavcurfiles = 'velavcurfile.nc' ! Vel. cur. daily av. input file name 1241 velhrcurfiles = 'velhrcurfile.nc' ! Vel. cur. high freq. input file name 1242 velavadcpfiles = 'velavadcpfile.nc' ! Vel. ADCP daily av. input file name 1243 velhradcpfiles = 'velhradcpfile.nc' ! Vel. ADCP high freq. input file name 1244 velfbfiles = 'velfbfile.nc' ! Vel. feedback input observation file name 1245 dobsini = 20000101.000000 ! Initial date in window YYYYMMDD.HHMMSS 1246 dobsend = 20010101.000000 ! Final date in window YYYYMMDD.HHMMSS 1247 n1dint = 0 ! Type of vertical interpolation method 1248 n2dint = 0 ! Type of horizontal interpolation method 1249 ln_nea = .false. ! Rejection of observations near land switch 1250 nmsshc = 0 ! MSSH correction scheme 1251 mdtcorr = 1.61 ! MDT correction 1252 mdtcutoff = 65.0 ! MDT cutoff for computed correction 1250 1253 ln_altbias = .false. ! Logical switch for alt bias 1251 1254 ln_ignmis = .true. ! Logical switch for ignoring missing files 1252 ! endailyavtypes ENACT daily average types1255 endailyavtypes = 820 ! ENACT daily average types - array (use namelist_cfg to set more values) 1253 1256 ln_grid_global = .true. 1254 1257 ln_grid_search_lookup = .false. … … 1257 1260 &nam_asminc ! assimilation increments ('key_asminc') 1258 1261 !----------------------------------------------------------------------- 1259 ln_bkgwri = .false. ! Logical switch for writing out background state 1260 ln_balwri = .false. ! Logical switch for writing out balancing increments 1261 ln_trainc = .false. ! Logical switch for applying tracer increments 1262 ln_dyninc = .false. ! Logical switch for applying velocity increments 1263 ln_sshinc = .false. ! Logical switch for applying SSH increments 1264 ln_asmdin = .false. ! Logical switch for Direct Initialization (DI) 1265 ln_asmiau = .false. ! Logical switch for Incremental Analysis Updating (IAU) 1266 ln_phytobal = .false. ! Logical switch for phytoplankton multivariate balancing 1267 ln_slchltotinc = .false. ! Logical switch for applying slchltot increments 1268 ln_slchldiainc = .false. ! Logical switch for applying slchldia increments 1269 ln_slchlnoninc = .false. ! Logical switch for applying slchlnon increments 1270 ln_slchlnaninc = .false. ! Logical switch for applying slchlnan increments 1271 ln_slchlpicinc = .false. ! Logical switch for applying slchlpic increments 1272 ln_slchldininc = .false. ! Logical switch for applying slchldin increments 1273 ln_schltotinc = .false. ! Logical switch for applying schltot increments 1274 ln_slphytotinc = .false. ! Logical switch for applying slphytot increments 1275 ln_slphydiainc = .false. ! Logical switch for applying slphydia increments 1276 ln_slphynoninc = .false. ! Logical switch for applying slphynon increments 1277 ln_sfco2inc = .false. ! Logical switch for applying sfCO2 increments 1278 ln_spco2inc = .false. ! Logical switch for applying spCO2 increments 1279 ln_plchltotinc = .false. ! Logical switch for applying plchltot increments 1280 ln_pchltotinc = .false. ! Logical switch for applying pchltot increments 1281 ln_pno3inc = .false. ! Logical switch for applying pno3 increments 1282 ln_psi4inc = .false. ! Logical switch for applying psi4 increments 1283 ln_ppo4inc = .false. ! Logical switch for applying ppo4 increments 1284 ln_pdicinc = .false. ! Logical switch for applying pdic increments 1285 ln_palkinc = .false. ! Logical switch for applying palk increments 1286 ln_pphinc = .false. ! Logical switch for applying pph increments 1287 ln_po2inc = .false. ! Logical switch for applying po2 increments 1288 nitbkg = 0 ! Timestep of background in [0,nitend-nit000-1] 1289 nitdin = 0 ! Timestep of background for DI in [0,nitend-nit000-1] 1290 nitiaustr = 1 ! Timestep of start of IAU interval in [0,nitend-nit000-1] 1291 nitiaufin = 15 ! Timestep of end of IAU interval in [0,nitend-nit000-1] 1292 niaufn = 0 ! Type of IAU weighting function 1293 ln_salfix = .false. ! Logical switch for ensuring that the sa > salfixmin 1294 salfixmin = -9999 ! Minimum salinity after applying the increments 1295 nn_divdmp = 0 ! Number of iterations of divergence damping operator 1296 mld_choice_bgc = 1 ! MLD criterion to use for biogeochemistry assimilation 1297 rn_maxchlinc = -999.0 ! maximum absolute non-log chlorophyll increment from ocean colour assimilation 1298 ! <= 0 implies no maximum applied (switch turned off) 1299 ! > 0 implies maximum absolute chl increment capped at this value 1262 ln_bkgwri = .false. ! Logical switch for writing out background state 1263 ln_trainc = .false. ! Logical switch for applying tracer increments 1264 ln_dyninc = .false. ! Logical switch for applying velocity increments 1265 ln_sshinc = .false. ! Logical switch for applying SSH increments 1266 ln_asmdin = .false. ! Logical switch for Direct Initialization (DI) 1267 ln_asmiau = .false. ! Logical switch for Incremental Analysis Updating (IAU) 1268 nitbkg = 0 ! Timestep of background in [0,nitend-nit000-1] 1269 nitdin = 0 ! Timestep of background for DI in [0,nitend-nit000-1] 1270 nitiaustr = 1 ! Timestep of start of IAU interval in [0,nitend-nit000-1] 1271 nitiaufin = 15 ! Timestep of end of IAU interval in [0,nitend-nit000-1] 1272 niaufn = 0 ! Type of IAU weighting function 1273 ln_salfix = .false. ! Logical switch for ensuring that the sa > salfixmin 1274 salfixmin = -9999 ! Minimum salinity after applying the increments 1275 nn_divdmp = 0 ! Number of iterations of divergence damping operator 1300 1276 / 1301 1277 !----------------------------------------------------------------------- -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/CONFIG/cfg.txt
r8058 r15480 4 4 ORCA2_SAS_LIM OPA_SRC SAS_SRC LIM_SRC_2 NST_SRC 5 5 C1D_PAPA OPA_SRC 6 C1D_PAPA_FABM_ERSEM OPA_SRC TOP_SRC 6 7 GYRE_BFM OPA_SRC TOP_SRC 7 8 AMM12 OPA_SRC 8 9 ORCA2_LIM_PISCES OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC 10 ORCA2_LIM_FABM_ERSEM OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC 9 11 GYRE OPA_SRC 10 12 ORCA2_LIM3 OPA_SRC LIM_SRC_3 NST_SRC 11 13 ORCA2_LIM OPA_SRC LIM_SRC_2 NST_SRC 12 14 ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC 15 AMM7 OPA_SRC 16 AMM7_MYTRC OPA_SRC TOP_SRC 17 AMM7_FABM_ERSEM OPA_SRC TOP_SRC -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/CONFIG/makenemo
r10162 r15480 75 75 # ========== 76 76 # 77 # $Id : makenemo 5144 2015-03-11 15:51:28Z timgraham$77 # $Id$ 78 78 # 79 79 # -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/EXTERNAL/IOIPSL/tools/rebuild
r8058 r15480 1 1 #!/bin/ksh 2 2 # 3 #$Id : rebuild 2281 2010-10-15 14:21:13Z smasson$3 #$Id$ 4 4 # 5 5 # This software is governed by the CeCILL license -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/EXTERNAL/IOIPSL/tools/tkcond.c
r8058 r15480 1 1 /* parser config.in 2 * $Id : tkcond.c 2281 2010-10-15 14:21:13Z smasson$2 * $Id$ 3 3 * 4 4 * This software is governed by the CeCILL license -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/EXTERNAL/IOIPSL/tools/tkgen.c
r8058 r15480 1 1 /* Generate tk script based upon config.in 2 * $Id : tkgen.c 2281 2010-10-15 14:21:13Z smasson$2 * $Id$ 3 3 * 4 4 * This software is governed by the CeCILL license -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/EXTERNAL/IOIPSL/tools/tkparse.c
r8058 r15480 1 1 /* parser config.in 2 * $Id : tkparse.c 2281 2010-10-15 14:21:13Z smasson$2 * $Id$ 3 3 * 4 4 * This software is governed by the CeCILL license -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/EXTERNAL/fcm/lib/Fcm/Config.pm
r8058 r15480 478 478 FC_OUTPUT => '-o', # FC flag, specify output file name 479 479 FC_INCLUDE => '-I', # FC flag, specify "include" path 480 FC_MODSEARCH => ' ', # FC flag, specify "module" path480 FC_MODSEARCH => '-J', # FC flag, specify "module" path 481 481 FC_DEFINE => '-D', # FC flag, define macro 482 482 -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/NEMO/OPA_SRC/BDY/bdylib.F90
r8059 r15480 419 419 ip = nint(bdypmask(ii+1,ij )*pmask(ii+1,ij,ik) - bdypmask(ii-1,ij )*pmask(ii-1,ij,ik)) 420 420 jp = nint(bdypmask(ii ,ij+1)*pmask(ii,ij+1,ik) - bdypmask(ii ,ij-1)*pmask(ii,ij-1,ik)) 421 phia(ii,ij,ik) = phia(ii+ip,ij+jp,ik) * pmask(ii+ip,ij+jp,ik) 421 phia(ii,ij,ik) = phia(ii+ip,ij+jp,ik) * pmask(ii+ip,ij+jp,ik) * pmask(ii,ij,ik) 422 422 ENDIF 423 423 END DO -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90
r8059 r15480 91 91 !! 92 92 REAL(wp) :: zwgt ! boundary weight 93 REAL(wp) :: zcoef, zcoef1,zcoef2 94 INTEGER :: ib, ik, igrd ! dummy loop indices 95 INTEGER :: ii, ij, ip, jp ! 2D addresses 93 INTEGER :: ib, ik, igrd ! dummy loop indices 94 INTEGER :: ii, ij ! 2D addresses 96 95 !!---------------------------------------------------------------------- 97 96 ! -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/NEMO/OPA_SRC/DIA/diatmb.F90
r10390 r15480 114 114 DO jj = 1,jpj 115 115 DO ji = 1,jpi 116 jk = max(1,mbathy(ji,jj) )116 jk = max(1,mbathy(ji,jj) - 1) 117 117 pouttmb(ji,jj,3) = pinfield(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk)) 118 118 END DO -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r8561 r15480 194 194 zztmpy = ( bfrva(ji, jj) * vn(ji,jj ,mbkv(ji,jj )) & 195 195 & + bfrva(ji,jj-1) * vn(ji,jj-1,mbkv(ji,jj-1)) ) 196 z2d(ji,jj) = rau0 * SQRT( zztmpx * zztmpx + zztmpy * zztmpy ) * tmask(ji,jj,1)196 z2d(ji,jj) = 0.5_wp * rau0 * SQRT( zztmpx * zztmpx + zztmpy * zztmpy ) * tmask(ji,jj,1) 197 197 ! 198 198 ENDDO -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
r8059 r15480 136 136 INTEGER :: ios 137 137 INTEGER :: isrow ! index for ORCA1 starting row 138 #if defined key_bdy && defined key_cs15 139 INTEGER :: inum !slwa 140 #endif 138 141 INTEGER , POINTER, DIMENSION(:,:) :: imsk 139 142 REAL(wp), POINTER, DIMENSION(:,:) :: zwf … … 173 176 CALL ctl_stop( ctmp1 ) 174 177 ENDIF 178 !slwa 179 ! read in mask for unstructured open boundaries 180 #if defined key_bdy && defined key_cs15 181 CALL iom_open( 'mask_CS15.nc', inum ) 182 CALL iom_get ( inum, jpdom_data, 'bdy_msk', zwf(:,:) ) 183 CALL iom_close( inum ) 184 #endif 185 !slwa 175 186 176 187 ! 1. Ocean/land mask at t-point (computed from mbathy) … … 183 194 DO ji = 1, jpi 184 195 IF( REAL( mbathy(ji,jj) - jk, wp ) + 0.1_wp >= 0._wp ) tmask(ji,jj,jk) = 1._wp 196 #if defined key_bdy && defined key_cs15 197 tmask(ji,jj,jk) = tmask(ji,jj,jk) * zwf(ji,jj) ! slwa 198 #endif 185 199 END DO 186 200 END DO -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r8058 r15480 1777 1777 #else 1778 1778 idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 1779 DO WHILE ( idx /= 0 ) 1780 IF ( output_freq%hour /= 0 ) THEN 1779 DO WHILE ( idx /= 0 ) 1780 IF ( output_freq%timestep /= 0) THEN 1781 WRITE(clfreq,'(I18,A2)')INT(output_freq%timestep),'ts' 1782 itrlen = LEN_TRIM(ADJUSTL(clfreq)) 1783 ELSE IF ( output_freq%second /= 0 ) THEN 1784 WRITE(clfreq,'(I19,A1)')INT(output_freq%second),'s' 1785 itrlen = LEN_TRIM(ADJUSTL(clfreq)) 1786 ELSE IF ( output_freq%minute /= 0 ) THEN 1787 WRITE(clfreq,'(I18,A2)')INT(output_freq%minute),'mi' 1788 itrlen = LEN_TRIM(ADJUSTL(clfreq)) 1789 ELSE IF ( output_freq%hour /= 0 ) THEN 1781 1790 WRITE(clfreq,'(I19,A1)')INT(output_freq%hour),'h' 1782 1791 itrlen = LEN_TRIM(ADJUSTL(clfreq)) -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90
r8059 r15480 204 204 DO ji = fs_2, fs_jpim1 ! vector opt. 205 205 #if defined key_tracer_budget 206 ! ptrd(ji,jj,jk) = - ( pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik) ) * tmask(ji,jj,jk) 207 ptrd(ji,jj,jk) = - pf (ji,jj,jk) * tmask(ji,jj,jk)206 ptrd(ji,jj,jk) = - ( pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik) ) * tmask(ji,jj,jk) & 207 & / ( e1t(ji,jj) * e2t(ji,jj) ) 208 208 #else 209 209 ptrd(ji,jj,jk) = - ( pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik) & -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/NEMO/OPA_SRC/module_example
r8058 r15480 52 52 !!---------------------------------------------------------------------- 53 53 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 54 !! $Id : module_example 4147 2013-11-04 11:51:55Z cetlod$54 !! $Id$ 55 55 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 56 56 !!---------------------------------------------------------------------- -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/NEMO/TOP_SRC/FABM/inputs_fabm.F90
r10158 r15480 19 19 USE fldread 20 20 USE par_fabm 21 USE fabm 21 USE fabm, only: type_fabm_horizontal_variable_id 22 22 23 23 IMPLICIT NONE 24 25 # include "vectopt_loop_substitute.h90" 24 26 25 27 PRIVATE … … 40 42 41 43 TYPE, PUBLIC, EXTENDS(type_input_variable) :: type_input_data 42 TYPE(type_ horizontal_variable_id):: horizontal_id43 TYPE(type_input_data), POINTER :: next => null()44 TYPE(type_fabm_horizontal_variable_id) :: horizontal_id 45 TYPE(type_input_data), POINTER :: next => null() 44 46 END TYPE 45 47 TYPE (type_input_data), POINTER, PUBLIC :: first_input_data => NULL() … … 87 89 ALLOCATE(input_data, STAT=ierr) 88 90 IF( ierr > 0 ) CALL ctl_stop( 'STOP', 'inputs_fabm:initialize_inputs: unable to allocate input_data object for variable '//TRIM(name) ) 89 input_data%horizontal_id = fabm_get_horizontal_variable_id(model,name)90 IF (.NOT. fabm_is_variable_used(input_data%horizontal_id)) THEN91 input_data%horizontal_id = model%get_horizontal_variable_id(name) 92 IF (.NOT.model%is_variable_used(input_data%horizontal_id)) THEN 91 93 ! This variable was not found among FABM's horizontal variables (at least, those that are read by one or more FABM modules) 92 94 CALL ctl_stop('STOP', 'inputs_fabm:initialize_inputs: variable "'//TRIM(name)//'" was not found among horizontal FABM variables.') … … 130 132 ! within tracer field 131 133 DO jn=1,jp_fabm 132 IF (TRIM(name) == TRIM(model% state_variables(jn)%name)) THEN134 IF (TRIM(name) == TRIM(model%interior_state_variables(jn)%name)) THEN 133 135 river_data%jp_pos = jp_fabm_m1+jn 134 136 END IF … … 173 175 ! Provide FABM with pointer to field that will receive prescribed data. 174 176 ! NB source=data_source_user guarantees that the prescribed data takes priority over any data FABM may already have for that variable. 175 CALL fabm_link_horizontal_data(model,input_data%horizontal_id,input_data%sf(1)%fnow(:,:,1),source=data_source_user)177 CALL model%link_horizontal_data(input_data%horizontal_id,input_data%sf(1)%fnow(:,:,1),source=data_source_user) 176 178 input_data => input_data%next 177 179 END DO … … 226 228 #endif 227 229 IF( kt == nit000 .OR. ( kt /= nit000 ) ) THEN 228 DO jj = 1, jpj229 DO ji = 1, jpi230 DO jj = 2, jpjm1 231 DO ji = fs_2, fs_jpim1 230 232 ! convert units and divide by surface area 231 233 ! loading / cell volume * vertical fraction of riverload … … 235 237 DO jk = 1,nk_rnf(ji,jj) 236 238 ! Add river loadings 237 tra(ji,jj,jk,river_data%jp_pos) = tra(ji,jj,jk,river_data%jp_pos) + river_data%sf(1)%fnow(ji,jj,1)*zcoef 239 if (river_data%rn_trrnfac>=0) then 240 tra(ji,jj,jk,river_data%jp_pos) = tra(ji,jj,jk,river_data%jp_pos) + river_data%sf(1)%fnow(ji,jj,1)*zcoef 241 else 242 !this is for the no river dilution option, where we give the runoff as riverload and we multiply by the current concentration 243 ! no need to use the full zcoeff because the run off is already surface specific, 1000. is to convert kg freshwater to m3 244 tra(ji,jj,jk,river_data%jp_pos) = tra(ji,jj,jk,river_data%jp_pos) + river_data%sf(1)%fnow(ji,jj,1)/1000._wp*trn(ji,jj,jk,river_data%jp_pos) / h_rnf(ji,jj) 245 endif 238 246 #if defined key_trdtrc && defined key_iomput 239 247 tr_inp(ji,jj,jk) = river_data%sf(1)%fnow(ji,jj,1)*zcoef -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/NEMO/TOP_SRC/FABM/par_fabm.F90
r10728 r15480 1 1 MODULE par_fabm 2 2 3 #if defined key_fabm 4 # include "fabm_version.h" 5 # if _FABM_API_VERSION_ < 1 6 # error You need FABM 1.0 or later 7 # endif 3 8 USE fabm 9 #endif 4 10 5 11 IMPLICIT NONE 6 7 TYPE (type_model) :: model !FABM model instance8 12 9 13 INTEGER, PUBLIC :: jp_fabm0, jp_fabm1, jp_fabm, & … … 38 42 39 43 #if defined key_fabm 44 CLASS (type_fabm_model), POINTER :: model !FABM model instance 45 40 46 !!--------------------------------------------------------------------- 41 47 !! 'key_fabm' FABM tracers -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/NEMO/TOP_SRC/FABM/trcini_fabm.F90
r10728 r15480 4 4 !! TOP : initialisation of the FABM tracers 5 5 !!====================================================================== 6 !! History : 2.0 ! 2007-12 (C. Ethe, G. Madec) Original code 6 !! History : 1.0 ! 2015-04 (PML) Original code 7 !! History : 1.1 ! 2020-06 (PML) Update to FABM 1.0, improved performance 7 8 !!---------------------------------------------------------------------- 8 9 #if defined key_fabm … … 17 18 USE par_fabm 18 19 USE trcsms_fabm 19 USE fabm _config,ONLY: fabm_create_model_from_yaml_file20 USE fabm ,ONLY: type_external_variable, fabm_initialize_library21 USE inputs_fabm,ONLY: initialize_inputs, link_inputs, &20 USE fabm, only: fabm_create_model, type_fabm_variable 21 USE fabm_driver 22 USE inputs_fabm,ONLY: initialize_inputs, link_inputs, & 22 23 type_input_variable,type_input_data,type_river_data, & 23 24 first_input_data,first_river_data … … 28 29 #endif 29 30 30 31 31 IMPLICIT NONE 32 32 PRIVATE 33 33 34 34 #if defined key_git_version 35 !#include "gitversion.h90"35 # include "gitversion.h90" 36 36 CHARACTER(len=*),parameter :: git_commit_id = _NEMO_COMMIT_ID_ 37 37 CHARACTER(len=*),parameter :: git_branch_name = _NEMO_BRANCH_ … … 39 39 40 40 PUBLIC trc_ini_fabm ! called by trcini.F90 module 41 PUBLIC nemo_fabm_init 41 PUBLIC nemo_fabm_configure 42 43 TYPE,extends(type_base_driver) :: type_nemo_fabm_driver 44 contains 45 procedure :: fatal_error => nemo_fabm_driver_fatal_error 46 procedure :: log_message => nemo_fabm_driver_log_message 47 end type 42 48 43 49 !!---------------------------------------------------------------------- … … 48 54 CONTAINS 49 55 50 SUBROUTINE nemo_fabm_ init()56 SUBROUTINE nemo_fabm_configure() 51 57 INTEGER :: jn 52 58 INTEGER, PARAMETER :: xml_unit = 1979 … … 55 61 CLASS (type_input_variable),POINTER :: input_pointer 56 62 63 ALLOCATE(type_nemo_fabm_driver::driver) 64 57 65 ! Allow FABM to parse fabm.yaml. This ensures numbers of variables are known. 58 call fabm_create_model_from_yaml_file(model)59 60 jp_fabm = size(model% state_variables)66 model => fabm_create_model() 67 68 jp_fabm = size(model%interior_state_variables) 61 69 jp_fabm_bottom = size(model%bottom_state_variables) 62 70 jp_fabm_surface = size(model%surface_state_variables) … … 65 73 jp_fabm_m1=jptra 66 74 jptra = jptra + jp_fabm 67 jp_fabm_2d = size(model%horizontal_diagnostic_variables) 68 jp_fabm_3d = size(model%diagnostic_variables) 69 jpdia2d = jpdia2d + jp_fabm_2d 70 jpdia3d = jpdia3d + jp_fabm_3d 75 jpdia2d = jpdia2d + size(model%horizontal_diagnostic_variables) 76 jpdia3d = jpdia3d + size(model%interior_diagnostic_variables) 71 77 jpdiabio = jpdiabio + jp_fabm 72 78 73 !Initialize input data structures. 79 ! Read inputs (river and additional 2D forcing) from fabm_input.nml 80 ! This must be done before writing field_def_fabm.xml, as that file 81 ! also describes the additional input variables. 74 82 call initialize_inputs 75 83 … … 138 146 WRITE (xml_unit,1000) ' <field_group id="ptrc_T" grid_ref="grid_T_3D">' 139 147 DO jn=1,jp_fabm 140 CALL write_variable_xml(xml_unit,model% state_variables(jn))148 CALL write_variable_xml(xml_unit,model%interior_state_variables(jn)) 141 149 #if defined key_trdtrc 142 CALL write_trends_xml(xml_unit,model% state_variables(jn))150 CALL write_trends_xml(xml_unit,model%interior_state_variables(jn)) 143 151 #endif 144 152 CALL write_25hourm_xml(xml_unit,model%state_variables(jn)) … … 159 167 160 168 WRITE (xml_unit,1000) ' <field_group id="diad_T" grid_ref="grid_T_2D">' 161 DO jn=1,size(model% diagnostic_variables)162 CALL write_variable_xml(xml_unit,model% diagnostic_variables(jn),3)163 CALL write_25hourm_xml(xml_unit,model% diagnostic_variables(jn),3)164 CALL write_tmb_xml(xml_unit,model% diagnostic_variables(jn))169 DO jn=1,size(model%interior_diagnostic_variables) 170 CALL write_variable_xml(xml_unit,model%interior_diagnostic_variables(jn),3) 171 CALL write_25hourm_xml(xml_unit,model%interior_diagnostic_variables(jn),3) 172 CALL write_tmb_xml(xml_unit,model%interior_diagnostic_variables(jn)) 165 173 END DO 166 174 DO jn=1,size(model%horizontal_diagnostic_variables) 167 175 CALL write_variable_xml(xml_unit,model%horizontal_diagnostic_variables(jn)) 168 176 CALL write_25hourm_xml(xml_unit,model%horizontal_diagnostic_variables(jn)) 177 END DO 178 DO jn=1,size(model%interior_state_variables) 179 WRITE (xml_unit,'(A)') ' <field id="'//TRIM(model%interior_state_variables(jn)%name)//'_VINT" & 180 long_name="depth-integrated '//TRIM(model%interior_state_variables(jn)%long_name)//'" unit="'//TRIM(model%interior_state_variables(jn)%units)//'*m" default_value="0.0" />' 181 END DO 182 DO jn=1,size(model%interior_diagnostic_variables) 183 WRITE (xml_unit,'(A)') ' <field id="'//TRIM(model%interior_diagnostic_variables(jn)%name)//'_VINT" & 184 long_name="depth-integrated '//TRIM(model%interior_diagnostic_variables(jn)%long_name)//'" unit="'//TRIM(model%interior_diagnostic_variables(jn)%units)//'*m" default_value="0.0" />' 169 185 END DO 170 186 WRITE (xml_unit,1000) ' </field_group>' … … 199 215 1000 FORMAT (A) 200 216 201 END SUBROUTINE nemo_fabm_ init217 END SUBROUTINE nemo_fabm_configure 202 218 203 219 SUBROUTINE write_variable_xml(xml_unit,variable,flag_grid_ref) 204 220 INTEGER,INTENT(IN) :: xml_unit 205 221 INTEGER,INTENT(IN),OPTIONAL :: flag_grid_ref 206 CLASS (type_ external_variable),INTENT(IN) :: variable222 CLASS (type_fabm_variable),INTENT(IN) :: variable 207 223 208 224 CHARACTER(LEN=20) :: missing_value,string_dimensions … … 283 299 INTEGER,INTENT(IN) :: xml_unit 284 300 INTEGER,INTENT(IN),OPTIONAL :: flag_grid_ref 285 CLASS (type_ external_variable),INTENT(IN) :: variable301 CLASS (type_fabm_variable),INTENT(IN) :: variable 286 302 287 303 INTEGER :: number_dimensions,i … … 325 341 END DO 326 342 WRITE (xml_unit,'(A)') ' <field id="'//TRIM(variable%name)//'_e3t" long_name="'//TRIM(variable%long_name)// & 327 & ' cell depth integrated" unit="'//TRIM(variable%units)//' /s" default_value="'// &343 & ' cell depth integrated" unit="'//TRIM(variable%units)//'*m" default_value="'// & 328 344 & TRIM(ADJUSTL(missing_value))//'" grid_ref="grid_T_3D" />' 329 345 #endif … … 342 358 END DO 343 359 WRITE (xml_unit,'(A)') ' <field id="'//TRIM(variable%name)//'_e3t" long_name="'//TRIM(variable%long_name)// & 344 & ' cell depth integrated" unit="'//TRIM(variable%units)//' /s" default_value="'// &360 & ' cell depth integrated" unit="'//TRIM(variable%units)//'*m" default_value="'// & 345 361 & TRIM(ADJUSTL(missing_value))//'" />' 346 362 #endif … … 387 403 !! ** Purpose : initialization for FABM model 388 404 !! 389 !! ** Method : - Read the namcfc namelist and check the parameter values405 !! ** Method : - Allocate FABM arrays, configure domain, send data 390 406 !!---------------------------------------------------------------------- 391 407 #if defined key_git_version … … 417 433 ! Log mapping of FABM states: 418 434 IF (lwp) THEN 419 IF (jp_fabm .gt.0) WRITE(numout,*) " FABM tracers:"435 IF (jp_fabm > 0) WRITE(numout,*) " FABM tracers:" 420 436 DO jn=1,jp_fabm 421 WRITE(numout,*) " State",jn,":",trim(model% state_variables(jn)%name), &422 " (",trim(model% state_variables(jn)%long_name), &423 ") [",trim(model% state_variables(jn)%units),"]"437 WRITE(numout,*) " State",jn,":",trim(model%interior_state_variables(jn)%name), & 438 " (",trim(model%interior_state_variables(jn)%long_name), & 439 ") [",trim(model%interior_state_variables(jn)%units),"]" 424 440 ENDDO 425 IF (jp_fabm_surface .gt.0) WRITE(numout,*) "FABM seasurface states:"441 IF (jp_fabm_surface > 0) WRITE(numout,*) "FABM seasurface states:" 426 442 DO jn=1,jp_fabm_surface 427 443 WRITE(numout,*) " State",jn,":",trim(model%surface_state_variables(jn)%name), & … … 429 445 ") [",trim(model%surface_state_variables(jn)%units),"]" 430 446 ENDDO 431 IF (jp_fabm_bottom .gt.0) WRITE(numout,*) "FABM seafloor states:"447 IF (jp_fabm_bottom > 0) WRITE(numout,*) "FABM seafloor states:" 432 448 DO jn=1,jp_fabm_bottom 433 449 WRITE(numout,*) " State",jn,":",trim(model%bottom_state_variables(jn)%name), & … … 438 454 439 455 END SUBROUTINE trc_ini_fabm 456 457 SUBROUTINE nemo_fabm_driver_fatal_error(self, location, message) 458 CLASS (type_nemo_fabm_driver), INTENT(INOUT) :: self 459 CHARACTER(len=*), INTENT(IN) :: location, message 460 461 CALL ctl_stop('STOP', TRIM(location)//': '//TRIM(message)) 462 STOP 463 END SUBROUTINE 464 465 SUBROUTINE nemo_fabm_driver_log_message(self, message) 466 CLASS (type_nemo_fabm_driver), INTENT(INOUT) :: self 467 CHARACTER(len=*), INTENT(IN) :: message 468 469 IF(lwp) WRITE (numout,*) TRIM(message) 470 END SUBROUTINE 440 471 441 472 INTEGER FUNCTION fabm_state_index( state_name ) … … 508 539 !!---------------------------------------------------------------------- 509 540 CONTAINS 510 SUBROUTINE nemo_fabm_ init511 END SUBROUTINE nemo_fabm_ init541 SUBROUTINE nemo_fabm_configure 542 END SUBROUTINE nemo_fabm_configure 512 543 513 544 SUBROUTINE trc_ini_fabm ! Empty routine -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/NEMO/TOP_SRC/FABM/trcnam_fabm.F90
r10270 r15480 4 4 !! TOP : initialisation of some run parameters for FABM bio-model 5 5 !!====================================================================== 6 !! History : 2.0 ! 2007-12 (C. Ethe, G. Madec) Original code 6 !! History : 1.0 ! 2015-04 (PML) Original code 7 !! History : 1.1 ! 2020-06 (PML) Update to FABM 1.0, improved performance 7 8 !!---------------------------------------------------------------------- 9 USE trc ! TOP variables 8 10 #if defined key_fabm 9 11 !!---------------------------------------------------------------------- … … 14 16 USE oce_trc ! Ocean variables 15 17 USE par_trc ! TOP parameters 16 USE trc ! TOP variables17 18 18 19 USE par_fabm 19 20 USE trcsms_fabm 20 21 21 22 22 IMPLICIT NONE … … 35 35 36 36 SUBROUTINE trc_nam_fabm 37 LOGICAL :: l_ext 38 INTEGER :: nmlunit, ios 39 NAMELIST/namfabm/ nn_adv 40 41 ! Read NEMO-FABM coupler settings from namfabm 42 nn_adv = 3 43 INQUIRE( FILE='namelist_fabm_ref', EXIST=l_ext ) 44 IF (l_ext) then 45 CALL ctl_opn( nmlunit, 'namelist_fabm_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE.) 46 READ(nmlunit, nml=namfabm, iostat=ios) 47 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namfabm in namelist_fabm_ref', .TRUE. ) 48 END IF 49 INQUIRE( FILE='namelist_fabm_cfg', EXIST=l_ext ) 50 IF (l_ext) then 51 CALL ctl_opn( nmlunit, 'namelist_fabm_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE.) 52 READ(nmlunit, nml=namfabm, iostat=ios) 53 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namfabm in namelist_fabm_cfg', .TRUE. ) 54 END IF 55 IF (nn_adv /= 1 .and. nn_adv /= 3) CALL ctl_stop( 'STOP', 'trc_ini_fabm: nn_adv must be 1 or 3.' ) 37 56 END SUBROUTINE trc_nam_fabm 38 57 39 SUBROUTINE trc_nam_fabm_override 58 SUBROUTINE trc_nam_fabm_override(sn_tracer) 59 TYPE(PTRACER), DIMENSION(jpmaxtrc), INTENT(INOUT) :: sn_tracer 60 40 61 INTEGER :: jn 62 CHARACTER(LEN=3) :: index 41 63 42 64 DO jn=1,jp_fabm 43 ctrcnm(jp_fabm_m1+jn) = model%state_variables(jn)%name 44 ctrcln(jp_fabm_m1+jn) = model%state_variables(jn)%long_name 45 ctrcun(jp_fabm_m1+jn) = model%state_variables(jn)%units 46 ln_trc_ini(jp_fabm_m1+jn) = .FALSE. 65 IF (sn_tracer(jn)%clsname /= 'NONAME' .AND. sn_tracer(jn)%clsname /= model%interior_state_variables(jn)%name) THEN 66 WRITE (index,'(i0)') jn 67 CALL ctl_stop('Tracer name mismatch in namtrc: '//TRIM(sn_tracer(jn)%clsname)//' found at sn_tracer('//TRIM(index)//') where '//TRIM(model%interior_state_variables(jn)%name)//' was expected.') 68 END IF 69 sn_tracer(jn)%clsname = TRIM(model%interior_state_variables(jn)%name) 70 sn_tracer(jn)%cllname = TRIM(model%interior_state_variables(jn)%long_name) 71 sn_tracer(jn)%clunit = TRIM(model%interior_state_variables(jn)%units) 72 sn_tracer(jn)%llinit = .FALSE. 47 73 END DO 48 74 END SUBROUTINE trc_nam_fabm_override 49 75 50 76 #else 51 77 !!---------------------------------------------------------------------- … … 56 82 END SUBROUTINE trc_nam_fabm 57 83 58 SUBROUTINE trc_nam_fabm_override 84 SUBROUTINE trc_nam_fabm_override (dummy) 85 TYPE(PTRACER), DIMENSION(jpmaxtrc), INTENT(INOUT), optional :: dummy 59 86 END SUBROUTINE trc_nam_fabm_override 60 87 #endif -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/NEMO/TOP_SRC/FABM/trcrst_fabm.F90
r10156 r15480 4 4 !! Read and write additional restart fields used by FABM 5 5 !!====================================================================== 6 !! History : 6 !! History : 1.0 ! 2015-04 (PML) Original code 7 !! History : 1.1 ! 2020-06 (PML) Update to FABM 1.0, improved performance 7 8 !!---------------------------------------------------------------------- 8 9 #if defined key_fabm -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/NEMO/TOP_SRC/FABM/trcsms_fabm.F90
r10728 r15480 24 24 25 25 USE oce, only: tsn ! Needed? 26 USE sbc_oce, only: lk_oasis 26 USE sbc_oce, only: lk_oasis,fr_i 27 27 USE dom_oce 28 28 USE zdf_oce 29 !USE iom29 USE iom 30 30 USE xios 31 31 USE cpl_oasis3 … … 54 54 PUBLIC compute_fabm ! Compute FABM sources, sinks and diagnostics 55 55 56 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: flux ! Cross-interface flux of pelagic variables (# m-2 s-1) 56 ! Work arrays 57 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: flux ! Cross-interface flux of pelagic variables (# m-2 s-1) 58 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: current_total ! Totals of conserved quantities 57 59 58 60 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ext ! Light extinction coefficient (m-1) 59 61 60 ! Work array for mass aggregation 61 REAL(wp), ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: current_total 62 63 64 ! Arrays for environmental variables 65 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:,:) :: prn,rho 66 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: taubot 67 68 ! repair counters 69 INTEGER :: repair_interior_count,repair_surface_count,repair_bottom_count 62 ! State repair counters 63 INTEGER, SAVE :: repair_interior_count = 0 64 INTEGER, SAVE :: repair_surface_count = 0 65 INTEGER, SAVE :: repair_bottom_count = 0 66 67 ! Coupler parameters 68 INTEGER, PUBLIC :: nn_adv ! Vertical advection scheme for sinking/floating/movement 69 ! (1: 1st order upwind, 3: 3rd order TVD) 70 71 ! Arrays for environmental variables that are computed by the coupler 72 REAL(wp), PUBLIC, TARGET, ALLOCATABLE, DIMENSION(:,:,:) :: prn,rho 73 REAL(wp), PUBLIC, TARGET, ALLOCATABLE, DIMENSION(:,:) :: taubot 74 REAL(wp), PUBLIC, TARGET :: daynumber_in_year 70 75 71 76 ! state check type … … 75 80 END TYPE 76 81 77 REAL(wp), PUBLIC :: daynumber_in_year 82 ! Flag indicating whether model%start has been called (will be done on-demand) 83 LOGICAL, SAVE :: started = .false. 78 84 79 85 TYPE (type_bulk_variable_id),SAVE :: swr_id … … 96 102 ! 97 103 INTEGER, INTENT(in) :: kt ! ocean time-step index 98 INTEGER :: jn 99 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrfabm 104 INTEGER :: jn, jk 105 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrfabm, pdat 106 REAL(wp), DIMENSION(jpi,jpj) :: vint 100 107 101 108 !!---------------------------------------------------------------------- … … 109 116 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 110 117 118 IF (.NOT. started) CALL nemo_fabm_start 119 111 120 CALL update_inputs( kt ) 112 121 113 CALL compute_fabm 114 115 CALL compute_vertical_movement( kt )122 CALL compute_fabm( kt ) 123 124 CALL compute_vertical_movement( kt, nn_adv ) 116 125 117 126 CALL st2d_fabm_nxt( kt ) … … 123 132 CALL trc_bc_read ( kt ) ! tracers: surface and lateral Boundary Conditions 124 133 CALL trc_rnf_fabm ( kt ) ! River forcings 134 135 ! Send 3D diagnostics to output (these apply to time "n") 136 DO jn = 1, size(model%interior_diagnostic_variables) 137 IF (model%interior_diagnostic_variables(jn)%save) THEN 138 ! Save 3D field 139 pdat => model%get_interior_diagnostic_data(jn) 140 CALL iom_put(model%interior_diagnostic_variables(jn)%name, pdat) 141 142 ! Save depth integral if selected for output in XIOS 143 IF (iom_use(TRIM(model%interior_diagnostic_variables(jn)%name)//'_VINT')) THEN 144 vint = 0._wp 145 DO jk = 1, jpkm1 146 vint = vint + pdat(:,:,jk) * fse3t(:,:,jk) * tmask(:,:,jk) 147 END DO 148 CALL iom_put(TRIM(model%interior_diagnostic_variables(jn)%name)//'_VINT', vint) 149 END IF 150 END IF 151 END DO 152 153 ! Send 2D diagnostics to output (these apply to time "n") 154 DO jn = 1, size(model%horizontal_diagnostic_variables) 155 IF (model%horizontal_diagnostic_variables(jn)%save) & 156 CALL iom_put( model%horizontal_diagnostic_variables(jn)%name, model%get_horizontal_diagnostic_data(jn)) 157 END DO 125 158 126 159 IF( l_trdtrc ) THEN ! Save the trends in the mixed layer … … 220 253 END SUBROUTINE asmdiags_fabm 221 254 222 SUBROUTINE compute_fabm() 255 SUBROUTINE compute_fabm( kt ) 256 INTEGER, INTENT(in) :: kt ! ocean time-step index 257 223 258 INTEGER :: ji,jj,jk,jn 224 TYPE(type_state) :: valid_state259 LOGICAL :: valid, repaired 225 260 REAL(wp) :: zalfg,zztmpx,zztmpy 226 261 227 262 ! Validate current model state (setting argument to .TRUE. enables repair=clipping) 228 valid_state = check_state(.TRUE.)229 IF (.NOT. valid_state%valid) THEN263 CALL check_state(.TRUE., valid, repaired) 264 IF (.NOT. valid) THEN 230 265 WRITE(numout,*) "Invalid value in FABM encountered in area ",narea,"!!!" 231 266 #if defined key_iomput … … 240 275 #endif 241 276 END IF 242 IF ( valid_state%repaired) THEN277 IF (repaired) THEN 243 278 WRITE(numout,*) "Total interior repairs up to now on process",narea,":",repair_interior_count 244 279 WRITE(numout,*) "Total surface repairs up to now on process",narea,":",repair_surface_count … … 246 281 ENDIF 247 282 283 daynumber_in_year=(fjulday-fjulstartyear+1)*1._wp 284 248 285 ! Compute the now hydrostatic pressure 249 286 ! copied from istate.F90 250 287 ! ------------------------------------ 251 288 252 zalfg = 0.5e-4 * grav ! FABM wants dbar, convert from Pa 253 254 rho = rau0 * ( 1. + rhd ) 255 256 prn(:,:,1) = 10.1325 + zalfg * fse3t(:,:,1) * rho(:,:,1) 257 258 daynumber_in_year=(fjulday-fjulstartyear+1)*1._wp 259 260 DO jk = 2, jpk ! Vertical integration from the surface 261 prn(:,:,jk) = prn(:,:,jk-1) + zalfg * ( & 262 fse3t(:,:,jk-1) * rho(:,:,jk-1) & 263 + fse3t(:,:,jk) * rho(:,:,jk) ) 264 END DO 265 266 ! Bottom stress 267 taubot(:,:) = 0._wp 268 DO jj = 2, jpjm1 269 DO ji = fs_2, fs_jpim1 ! vector opt. 270 zztmpx = ( bfrua(ji ,jj) * un(ji ,jj,mbku(ji ,jj)) & 271 & + bfrua(ji-1,jj) * un(ji-1,jj,mbku(ji-1,jj)) ) 272 zztmpy = ( bfrva(ji, jj) * vn(ji,jj ,mbkv(ji,jj )) & 273 & + bfrva(ji,jj-1) * vn(ji,jj-1,mbkv(ji,jj-1)) ) 274 taubot(ji,jj) = 0.5_wp * rau0 * SQRT( zztmpx * zztmpx + zztmpy * zztmpy ) * tmask(ji,jj,1) 275 ! 289 IF (ALLOCATED(rho)) rho = rau0 * ( 1._wp + rhd ) 290 291 IF (ALLOCATED(prn)) THEN 292 zalfg = 0.5e-4_wp * grav ! FABM wants dbar, convert from Pa (and multiply with 0.5 to average 2 cell thicknesses below) 293 prn(:,:,1) = 10.1325_wp + zalfg * fse3t(:,:,1) * rho(:,:,1) 294 DO jk = 2, jpkm1 ! Vertical integration from the surface 295 prn(:,:,jk) = prn(:,:,jk-1) + zalfg * ( & 296 fse3t(:,:,jk-1) * rho(:,:,jk-1) & 297 + fse3t(:,:,jk) * rho(:,:,jk) ) 298 END DO 299 END IF 300 301 ! Compute the bottom stress 302 ! copied from diawri.F90 303 ! ------------------------------------ 304 305 IF (ALLOCATED(taubot)) THEN 306 taubot(:,:) = 0._wp 307 DO jj = 2, jpjm1 308 DO ji = fs_2, fs_jpim1 ! vector opt. 309 zztmpx = ( bfrua(ji ,jj) * un(ji ,jj,mbku(ji ,jj)) & 310 & + bfrua(ji-1,jj) * un(ji-1,jj,mbku(ji-1,jj)) ) 311 zztmpy = ( bfrva(ji, jj) * vn(ji,jj ,mbkv(ji,jj )) & 312 & + bfrva(ji,jj-1) * vn(ji,jj-1,mbkv(ji,jj-1)) ) 313 taubot(ji,jj) = 0.5_wp * rau0 * SQRT( zztmpx * zztmpx + zztmpy * zztmpy ) * tmask(ji,jj,1) 314 ! 315 ENDDO 276 316 ENDDO 277 ENDDO 317 ENDIF 318 278 319 ! Compute light extinction 279 320 DO jk=1,jpk … … 296 337 297 338 ! Compute interfacial source terms and fluxes 298 DO jj= 1,jpj299 ! Process bottom ( fabm_do_bottomincrements rather than sets, so zero flux array first)339 DO jj=2,jpjm1 340 ! Process bottom (get_bottom_sources increments rather than sets, so zero flux array first) 300 341 flux = 0._wp 301 CALL fabm_do_bottom(model,1,jpi,jj,flux,fabm_st2Da(:,jj,jp_fabm_surface+1:))342 CALL model%get_bottom_sources(fs_2,fs_jpim1,jj,flux,fabm_st2Da(fs_2:fs_jpim1,jj,jp_fabm_surface+1:)) 302 343 DO jn=1,jp_fabm 303 DO ji=1,jpi 304 ! Divide bottom fluxes by height of bottom layer and add to source terms. 305 ! TODO: is there perhaps an existing variable for fse3t(ji,jj,mbkt(ji,jj))?? 306 tra(ji,jj,mbkt(ji,jj),jp_fabm_m1+jn) = tra(ji,jj,mbkt(ji,jj),jp_fabm_m1+jn) + flux(ji,jn)/fse3t(ji,jj,mbkt(ji,jj)) 307 END DO 308 END DO 309 310 ! Process surface (fabm_do_surface increments rather than sets, so zero flux array first) 344 ! Divide bottom fluxes by height of bottom layer and add to source terms. 345 DO ji=fs_2,fs_jpim1 346 tra(ji,jj,mbkt(ji,jj),jp_fabm_m1+jn) = tra(ji,jj,mbkt(ji,jj),jp_fabm_m1+jn) + flux(ji,jn)/fse3t(ji,jj,mbkt(ji,jj)) 347 END DO 348 END DO 349 350 ! Process surface (get_surface_sources increments rather than sets, so zero flux array first) 311 351 flux = 0._wp 312 352 CALL fabm_do_surface(model,1,jpi,jj,flux,fabm_st2Da(:,jj,1:jp_fabm_surface)) 313 353 DO jn=1,jp_fabm 314 ! Divide surface fluxes by height of surface layer and add to source terms. 315 tra(:,jj,1,jp_fabm_m1+jn) = tra(:,jj,1,jp_fabm_m1+jn) + flux(:,jn)/fse3t(:,jj,1) 316 END DO 317 END DO 318 319 ! Compute interior source terms (NB fabm_do increments rather than sets) 320 DO jk=1,jpk 321 DO jj=1,jpj 322 CALL fabm_do(model,1,jpi,jj,jk,tra(:,jj,jk,jp_fabm0:jp_fabm1)) 323 END DO 324 END DO 354 DO ji=fs_2,fs_jpim1 355 tra(ji,jj,1,jp_fabm_m1+jn) = tra(ji,jj,1,jp_fabm_m1+jn) + flux(ji,jn)/fse3t(ji,jj,1) 356 END DO 357 END DO 358 END DO 359 360 ! Compute interior source terms (NB get_interior_sources increments rather than sets) 361 DO jk=1,jpkm1 362 DO jj=2,jpjm1 363 CALL model%get_interior_sources(fs_2,fs_jpim1,jj,jk,tra(fs_2:fs_jpim1,jj,jk,jp_fabm0:jp_fabm1)) 364 END DO 365 END DO 366 367 CALL model%finalize_outputs() 325 368 END SUBROUTINE compute_fabm 326 369 327 FUNCTION check_state(repair) RESULT(exit_state)328 LOGICAL, INTENT(IN) :: repair329 TYPE(type_state) :: exit_state330 331 INTEGER :: jj,jk332 LOGICAL :: valid_int,valid_sf,valid_bt333 334 exit_state%valid = .TRUE.335 exit_state%repaired =.FALSE.336 DO jk=1,jpk 337 DO jj= 1,jpj338 CALL fabm_check_state(model,1,jpi,jj,jk,repair,valid_int)339 IF (repair .AND..NOT.valid_int) THEN370 SUBROUTINE check_state(repair, valid, repaired) 371 LOGICAL, INTENT(IN) :: repair 372 LOGICAL, INTENT(OUT) :: valid, repaired 373 374 INTEGER :: jj, jk 375 LOGICAL :: valid_int, valid_sf, valid_bt 376 377 valid = .TRUE. ! Whether the model state is valid after this subroutine returns 378 repaired = .FALSE. ! Whether the model state has been repaired by this subroutine 379 DO jk=1,jpkm1 380 DO jj=2,jpjm1 381 CALL model%check_interior_state(fs_2, fs_jpim1, jj, jk, repair, valid_int) 382 IF (repair .AND. .NOT. valid_int) THEN 340 383 repair_interior_count = repair_interior_count + 1 341 exit_state%repaired = .TRUE.384 repaired = .TRUE. 342 385 END IF 343 IF (.NOT. (valid_int.OR.repair)) exit_state%valid = .FALSE.344 END DO 345 END DO 346 DO jj= 1,jpj347 CALL fabm_check_surface_state(model,1,jpi,jj,repair,valid_sf)348 IF (repair .AND..NOT.valid_sf) THEN386 IF (.NOT. (valid_int .OR. repair)) valid = .FALSE. 387 END DO 388 END DO 389 DO jj=2,jpjm1 390 CALL model%check_surface_state(fs_2, fs_jpim1, jj, repair, valid_sf) 391 IF (repair .AND. .NOT. valid_sf) THEN 349 392 repair_surface_count = repair_surface_count + 1 350 exit_state%repaired = .TRUE.393 repaired = .TRUE. 351 394 END IF 352 IF (.NOT. (valid_sf.AND.valid_bt).AND..NOT.repair) exit_state%valid = .FALSE.353 CALL fabm_check_bottom_state(model,1,jpi,jj,repair,valid_bt)354 IF (repair .AND..NOT.valid_bt) THEN395 IF (.NOT. (valid_sf .AND. valid_bt) .AND. .NOT. repair) valid = .FALSE. 396 CALL model%check_bottom_state(fs_2, fs_jpim1, jj, repair, valid_bt) 397 IF (repair .AND. .NOT. valid_bt) THEN 355 398 repair_bottom_count = repair_bottom_count + 1 356 exit_state%repaired = .TRUE.399 repaired = .TRUE. 357 400 END IF 358 IF (.NOT. (valid_sf.AND.valid_bt).AND..NOT.repair) exit_state%valid = .FALSE.359 END DO 360 END FUNCTION401 IF (.NOT. (valid_sf .AND. valid_bt) .AND. .NOT. repair) valid = .FALSE. 402 END DO 403 END SUBROUTINE 361 404 362 405 SUBROUTINE trc_sms_fabm_check_mass() 363 406 REAL(wp) :: total(SIZE(model%conserved_quantities)) 364 INTEGER :: j k,jj,jn407 INTEGER :: ji,jk,jj,jn 365 408 366 409 total = 0._wp 367 410 368 DO jk=1,jpk 369 DO jj=1,jpj 370 CALL fabm_get_conserved_quantities(model,1,jpi,jj,jk,current_total) 411 IF (.NOT. started) CALL nemo_fabm_start 412 413 DO jk=1,jpkm1 414 DO jj=2,jpjm1 415 CALL model%get_interior_conserved_quantities(fs_2,fs_jpim1,jj,jk,current_total) 371 416 DO jn=1,SIZE(model%conserved_quantities) 372 total(jn) = total(jn) + SUM(cvol(:,jj,jk)*current_total(:,jn)*tmask_i(:,jj)) 417 DO ji=fs_2,fs_jpim1 418 total(jn) = total(jn) + cvol(ji,jj,jk) * current_total(ji,jn) * tmask_i(ji,jj) 419 END DO 373 420 END DO 374 421 END DO 375 422 END DO 376 423 377 DO jj= 1,jpj378 CALL fabm_get_horizontal_conserved_quantities(model,1,jpi,jj,current_total)424 DO jj=2,jpjm1 425 CALL model%get_horizontal_conserved_quantities(fs_2,fs_jpim1,jj,current_total) 379 426 DO jn=1,SIZE(model%conserved_quantities) 380 total(jn) = total(jn) + SUM(e1e2t(:,jj)*current_total(:,jn)*tmask_i(:,jj)) 427 DO ji=fs_2,fs_jpim1 428 total(jn) = total(jn) + e1e2t(ji,jj) * current_total(ji,jn) * tmask_i(ji,jj) 429 END DO 381 430 END DO 382 431 END DO … … 434 483 435 484 INTEGER FUNCTION trc_sms_fabm_alloc() 436 INTEGER :: j j,jk,jn485 INTEGER :: jn 437 486 !!---------------------------------------------------------------------- 438 487 !! *** ROUTINE trc_sms_fabm_alloc *** … … 441 490 ! ALLOCATE here the arrays specific to FABM 442 491 ALLOCATE( lk_rad_fabm(jp_fabm)) 443 ALLOCATE(prn(jpi, jpj, jpk))444 ALLOCATE(rho(jpi, jpj, jpk))445 ALLOCATE(taubot(jpi, jpj))492 IF (model%variable_needs_values(fabm_standard_variables%pressure)) ALLOCATE(prn(jpi, jpj, jpk)) 493 IF (ALLOCATED(prn) .or. model%variable_needs_values(fabm_standard_variables%density)) ALLOCATE(rho(jpi, jpj, jpk)) 494 IF (model%variable_needs_values(fabm_standard_variables%bottom_stress)) ALLOCATE(taubot(jpi, jpj)) 446 495 ! ALLOCATE( tab(...) , STAT=trc_sms_fabm_alloc ) 447 496 … … 452 501 453 502 ! Work array to hold surface and bottom fluxes 454 ALLOCATE(flux(jpi,jp_fabm)) 455 456 ! Work array to hold extinction coefficients 457 ALLOCATE(ext(jpi)) 458 ext=0._wp 503 ALLOCATE(flux(fs_2:fs_jpim1,jp_fabm)) 459 504 460 505 ! Allocate work arrays for vertical movement 461 ALLOCATE(w_ct(jpi,jpk,jp_fabm)) 462 ALLOCATE(w_if(jpk,jp_fabm)) 463 ALLOCATE(zwgt_if(jpk,jp_fabm)) 464 ALLOCATE(flux_if(jpk,jp_fabm)) 465 ALLOCATE(current_total(jpi,SIZE(model%conserved_quantities))) 506 ALLOCATE(w_ct(fs_2:fs_jpim1,1:jpkm1,jp_fabm)) 507 ALLOCATE(current_total(fs_2:fs_jpim1,SIZE(model%conserved_quantities))) 466 508 #if defined key_trdtrc && defined key_iomput 467 509 IF( lk_trdtrc ) ALLOCATE(tr_vmv(jpi,jpj,jpk,jp_fabm)) … … 474 516 ! 475 517 476 ! Make FABM aware of diagnostics that are not needed [not included in output] 477 DO jn=1,size(model%diagnostic_variables) 478 !model%diagnostic_variables(jn)%save = iom_use(model%diagnostic_variables(jn)%name) 479 END DO 480 DO jn=1,size(model%horizontal_diagnostic_variables) 481 !model%horizontal_diagnostic_variables(jn)%save = iom_use(model%horizontal_diagnostic_variables(jn)%name) 482 END DO 483 484 ! Provide FABM with domain extents [after this, the save attribute of diagnostic variables can no longe change!] 485 call fabm_set_domain(model,jpi, jpj, jpk) 486 487 ! Provide FABM with the vertical indices of the surface and bottom, and the land-sea mask. 488 call model%set_bottom_index(mbkt) ! NB mbkt extents should match dimension lengths provided to fabm_set_domain 489 call model%set_surface_index(1) 490 call fabm_set_mask(model,tmask,tmask(:,:,1)) ! NB tmask extents should match dimension lengths provided to fabm_set_domain 491 492 ! Send pointers to state data to FABM 493 do jn=1,jp_fabm 494 call fabm_link_bulk_state_data(model,jn,trn(:,:,:,jp_fabm_m1+jn)) 495 end do 518 ! Provide FABM with domain extents 519 CALL model%set_domain(jpi, jpj, jpk, rdt) 520 CALL model%set_domain_start(fs_2, 2, 1) 521 CALL model%set_domain_stop(fs_jpim1, jpjm1, jpkm1) 522 523 ! Provide FABM with the vertical indices of the bottom, and the land-sea mask. 524 CALL model%set_bottom_index(mbkt) ! NB mbkt extents should match dimension lengths provided to set_domain 525 CALL model%set_mask(tmask,tmask(:,:,1)) ! NB tmask extents should match dimension lengths provided to set_domain 526 527 ! Initialize state and send pointers to state data to FABM 528 ! We mask land points in states with zeros, as per with NEMO "convention" 529 ! NB we cannot call model%initialize_*_state at this point, because model%start has not been called yet. 530 DO jn=1,jp_fabm 531 trn(:,:,:,jp_fabm_m1+jn) = model%interior_state_variables(jn)%initial_value * tmask 532 CALL model%link_interior_state_data(jn,trn(:,:,:,jp_fabm_m1+jn)) 533 END DO 496 534 DO jn=1,jp_fabm_surface 497 CALL fabm_link_surface_state_data(model,jn,fabm_st2Dn(:,:,jn)) 535 fabm_st2Dn(:,:,jn) = model%surface_state_variables(jn)%initial_value * tmask(:,:,1) 536 CALL model%link_surface_state_data(jn,fabm_st2Dn(:,:,jn)) 498 537 END DO 499 538 DO jn=1,jp_fabm_bottom 500 CALL fabm_link_bottom_state_data(model,jn,fabm_st2Dn(:,:,jp_fabm_surface+jn)) 539 fabm_st2Dn(:,:,jp_fabm_surface+jn) = model%bottom_state_variables(jn)%initial_value * tmask(:,:,1) 540 CALL model%link_bottom_state_data(jn,fabm_st2Dn(:,:,jp_fabm_surface+jn)) 501 541 END DO 502 542 503 543 ! Send pointers to environmental data to FABM 504 call fabm_link_bulk_data(model,standard_variables%temperature,tsn(:,:,:,jp_tem)) 505 call fabm_link_bulk_data(model,standard_variables%practical_salinity,tsn(:,:,:,jp_sal)) 506 call fabm_link_bulk_data(model,standard_variables%density,rho(:,:,:)) 507 call fabm_link_bulk_data(model,standard_variables%pressure,prn) 508 call fabm_link_horizontal_data(model,standard_variables%bottom_stress,taubot(:,:)) 509 ! correct target for cell thickness depends on NEMO configuration: 510 #ifdef key_vvl 511 call fabm_link_bulk_data(model,standard_variables%cell_thickness,e3t_n) 512 #else 513 call fabm_link_bulk_data(model,standard_variables%cell_thickness,e3t_0) 514 #endif 515 call fabm_link_horizontal_data(model,standard_variables%latitude,gphit) 516 call fabm_link_horizontal_data(model,standard_variables%longitude,glamt) 517 call fabm_link_scalar_data(model,standard_variables%number_of_days_since_start_of_the_year,daynumber_in_year) 518 call fabm_link_horizontal_data(model,standard_variables%wind_speed,wndm(:,:)) 519 call fabm_link_horizontal_data(model,standard_variables%surface_downwelling_shortwave_flux,qsr(:,:)) 520 call fabm_link_horizontal_data(model,standard_variables%bottom_depth_below_geoid,bathy(:,:)) 521 522 swr_id = model%get_bulk_variable_id(standard_variables%downwelling_shortwave_flux) 544 CALL model%link_interior_data(fabm_standard_variables%depth, fsdept(:,:,:)) 545 CALL model%link_interior_data(fabm_standard_variables%temperature, tsn(:,:,:,jp_tem)) 546 CALL model%link_interior_data(fabm_standard_variables%practical_salinity, tsn(:,:,:,jp_sal)) 547 IF (ALLOCATED(rho)) CALL model%link_interior_data(fabm_standard_variables%density, rho(:,:,:)) 548 IF (ALLOCATED(prn)) CALL model%link_interior_data(fabm_standard_variables%pressure, prn) 549 IF (ALLOCATED(taubot)) CALL model%link_horizontal_data(fabm_standard_variables%bottom_stress, taubot(:,:)) 550 CALL model%link_interior_data(fabm_standard_variables%cell_thickness, fse3t(:,:,:)) 551 CALL model%link_horizontal_data(fabm_standard_variables%latitude, gphit) 552 CALL model%link_horizontal_data(fabm_standard_variables%longitude, glamt) 553 CALL model%link_scalar(fabm_standard_variables%number_of_days_since_start_of_the_year, daynumber_in_year) 554 CALL model%link_horizontal_data(fabm_standard_variables%wind_speed, wndm(:,:)) 555 CALL model%link_horizontal_data(fabm_standard_variables%surface_downwelling_shortwave_flux, qsr(:,:)) 556 CALL model%link_horizontal_data(fabm_standard_variables%bottom_depth_below_geoid, bathy(:,:)) 557 CALL model%link_horizontal_data(fabm_standard_variables%ice_area_fraction, fr_i(:,:)) 523 558 524 559 ! Obtain user-specified input variables (read from NetCDF file) 525 call link_inputs 526 call update_inputs( nit000, .false. ) 527 528 ! Check whether FABM has all required data 529 call fabm_check_ready(model) 530 531 ! Initialize state 532 DO jj=1,jpj 533 CALL fabm_initialize_surface_state(model,1,jpi,jj) 534 CALL fabm_initialize_bottom_state(model,1,jpi,jj) 535 END DO 536 DO jk=1,jpk 537 DO jj=1,jpj 538 CALL fabm_initialize_state(model,1,jpi,jj,jk) 539 END DO 540 END DO 560 CALL link_inputs 561 CALL update_inputs(nit000, .FALSE.) 541 562 542 563 ! Set mask for negativity corrections to the relevant states 543 lk_rad_fabm = .FALSE.564 lk_rad_fabm(:) = .FALSE. 544 565 DO jn=1,jp_fabm 545 IF (model% state_variables(jn)%minimum.ge.0) THEN546 lk_rad_fabm(jn) =.TRUE.547 IF(lwp) WRITE(numout,*) 'FABM clipping for '//TRIM(model% state_variables(jn)%name)//' activated.'566 IF (model%interior_state_variables(jn)%minimum >= 0._wp) THEN 567 lk_rad_fabm(jn) = .TRUE. 568 IF(lwp) WRITE(numout,*) 'FABM clipping for '//TRIM(model%interior_state_variables(jn)%name)//' activated.' 548 569 END IF 549 570 END DO … … 573 594 END FUNCTION trc_sms_fabm_alloc 574 595 596 SUBROUTINE nemo_fabm_start() 597 INTEGER :: jn 598 599 ! Make FABM aware of diagnostics that are not needed [not included in output] 600 ! This works only after iom has completely initialised, because it depends on iom_use 601 DO jn=1,size(model%interior_diagnostic_variables) 602 model%interior_diagnostic_variables(jn)%save = iom_use(model%interior_diagnostic_variables(jn)%name) & 603 .or. iom_use(TRIM(model%interior_diagnostic_variables(jn)%name)//'_VINT') 604 END DO 605 DO jn=1,size(model%horizontal_diagnostic_variables) 606 model%horizontal_diagnostic_variables(jn)%save = iom_use(model%horizontal_diagnostic_variables(jn)%name) 607 END DO 608 609 ! Check whether FABM has all required data 610 ! [after this, the save attribute of diagnostic variables can no longer change!] 611 CALL model%start() 612 613 started = .TRUE. 614 END SUBROUTINE 615 575 616 #else 576 617 !!---------------------------------------------------------------------- -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/NEMO/TOP_SRC/FABM/trcwri_fabm.F90
r10270 r15480 4 4 !! fabm : Output of FABM tracers 5 5 !!====================================================================== 6 !! History : 1.0 ! 2009-05 (C. Ethe) Original code 6 !! History : 1.0 ! 2015-04 (PML) Original code 7 !! History : 1.1 ! 2020-06 (PML) Update to FABM 1.0, improved performance 7 8 !!---------------------------------------------------------------------- 8 9 #if defined key_top && key_fabm && defined key_iomput … … 18 19 USE par_fabm 19 20 USE st2d_fabm 20 USE fabm, only: fabm_get_bulk_diagnostic_data, fabm_get_horizontal_diagnostic_data21 USE,INTRINSIC :: iso_fortran_env, only: output_unit 21 22 22 23 IMPLICIT NONE … … 31 32 MODULE PROCEDURE wri_fabm,wri_fabm_fl 32 33 END INTERFACE trc_wri_fabm 33 34 34 35 35 PUBLIC trc_wri_fabm … … 58 58 ! depth integrated 59 59 ! for strict budgetting write this out at end of timestep as an average between 'now' and 'after' at kt 60 DO jn = 1, jp_fabm 161 IF(ln_trdtrc (j n))THEN62 trpool(:,:,:) = 0.5 * ( trn(:,:,:,jp_fabm 0+jn-1)*fse3t_a(:,:,:) + &60 DO jn = 1, jp_fabm 61 IF(ln_trdtrc (jp_fabm_m1+jn))THEN 62 trpool(:,:,:) = 0.5 * ( trn(:,:,:,jp_fabm_m1+jn)*fse3t_a(:,:,:) + & 63 63 tr_temp(:,:,:,jn)*fse3t(:,:,:) ) 64 cltra = TRIM( model% state_variables(jn)%name )//"_e3t" ! depth integrated output65 IF( kt == nittrc000 ) write( 6,*)'output pool ',cltra64 cltra = TRIM( model%interior_state_variables(jn)%name )//"_e3t" ! depth integrated output 65 IF( kt == nittrc000 ) write(output_unit,*)'output pool ',cltra 66 66 CALL iom_put( cltra, trpool) 67 67 ENDIF … … 80 80 !!--------------------------------------------------------------------- 81 81 INTEGER, INTENT( in ) :: kt 82 INTEGER :: jn 82 INTEGER :: jn, jk 83 REAL(wp), DIMENSION(jpi,jpj) :: vint 83 84 84 85 #if defined key_tracer_budget … … 90 91 #endif 91 92 DO jn = 1, jp_fabm 92 CALL iom_put( model%state_variables(jn)%name, trn(:,:,:,jp_fabm0+jn-1) ) 93 ! Save 3D field 94 CALL iom_put(model%interior_state_variables(jn)%name, trn(:,:,:,jp_fabm_m1+jn)) 95 96 ! Save depth integral if selected for output in XIOS 97 IF (iom_use(TRIM(model%interior_state_variables(jn)%name)//'_VINT')) THEN 98 vint = 0._wp 99 DO jk = 1, jpkm1 100 vint = vint + trn(:,:,jk,jp_fabm_m1+jn) * fse3t(:,:,jk) * tmask(:,:,jk) 101 END DO 102 CALL iom_put(TRIM(model%interior_state_variables(jn)%name)//'_VINT', vint) 103 END IF 93 104 END DO 94 105 DO jn = 1, jp_fabm_surface … … 121 132 !! Dummy module : No passive tracer 122 133 !!---------------------------------------------------------------------- 134 INTERFACE trc_wri_fabm 135 MODULE PROCEDURE wri_fabm,wri_fabm_fl 136 END INTERFACE trc_wri_fabm 137 123 138 PUBLIC trc_wri_fabm 124 CONTAINS 125 SUBROUTINE trc_wri_fabm ! Empty routine 126 END SUBROUTINE trc_wri_fabm 139 140 CONTAINS 141 142 SUBROUTINE wri_fabm_fl(kt,fl) 143 INTEGER, INTENT( in ) :: fl 144 INTEGER, INTENT( in ) :: kt 145 END SUBROUTINE wri_fabm_fl 146 147 SUBROUTINE wri_fabm(kt) ! Empty routine 148 INTEGER, INTENT( in ) :: kt 149 END SUBROUTINE wri_fabm 150 127 151 #endif 128 152 -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/NEMO/TOP_SRC/FABM/vertical_movement_fabm.F90
r10156 r15480 25 25 26 26 # include "domzgr_substitute.h90" 27 # include "vectopt_loop_substitute.h90" 27 28 28 29 PRIVATE … … 41 42 CONTAINS 42 43 43 SUBROUTINE compute_vertical_movement( kt )44 SUBROUTINE compute_vertical_movement( kt, method ) 44 45 !!---------------------------------------------------------------------- 45 46 !! *** compute_vertical_movement *** 46 47 !! 47 !! ** Purpose : compute vertical movement of FABM tracers 48 !! ** Purpose : compute vertical movement of FABM tracers through the water 49 !! (sinking/floating/active movement) 48 50 !! 49 !! ** Method : Sets additional vertical velocity field and computes 50 !! resulting advection using a conservative 3rd upwind 51 !! scheme with QUICKEST TVD limiter, based on GOTM 52 !! module adv_center.F90 (www.gotm.net). Currently assuming 53 !! zero flux at sea surface and sea floor. 51 !! ** Method : Retrieves additional vertical velocity field and applies 52 !! advection scheme. 54 53 !!---------------------------------------------------------------------- 55 54 ! 56 INTEGER, INTENT(in) :: kt ! ocean time-step index 57 INTEGER :: ji,jj,jk,jn,k_floor,n_iter,n_count 58 INTEGER,PARAMETER :: n_itermax=100 59 REAL(wp) :: cmax_no,z2dt 60 REAL(wp),DIMENSION(jpk) :: tr_it,tr_u,tr_d,tr_c,tr_slope,c_no,flux_lim 61 REAL(wp),DIMENSION(jpk) :: phi_lim,x_fac 55 INTEGER, INTENT(in) :: kt ! ocean time-step index 56 INTEGER, INTENT(in) :: method ! advection method (1: 1st order upstream, 3: 3rd order TVD with QUICKEST limiter) 57 58 INTEGER :: ji,jj,jk,jn,k_floor 59 REAL(wp) :: zwgt_if(1:jpkm1-1), dc(1:jpkm1), w_if(1:jpkm1-1), z2dt, h(1:jpkm1) 62 60 #if defined key_trdtrc 63 61 CHARACTER (len=20) :: cltra … … 69 67 70 68 IF( neuler == 0 .AND. kt == nittrc000 ) THEN 71 69 z2dt = rdt ! set time step size (Euler) 72 70 ELSE 73 71 z2dt = 2._wp * rdt ! set time step size (Leapfrog) 74 72 ENDIF 73 75 74 ! Compute interior vertical velocities and include them in source array. 76 DO jj= 1,jpj! j-loop77 ! Get vertical velocities at layer centres (entire 1:jpi,1:jpk slice).78 DO jk=1,jpk 79 CALL fabm_get_vertical_movement(model,1,jpi,jj,jk,w_ct(:,jk,:))75 DO jj=2,jpjm1 ! j-loop 76 ! Get vertical velocities at layer centres (entire i-k slice). 77 DO jk=1,jpkm1 78 CALL model%get_vertical_movement(fs_2,fs_jpim1,jj,jk,w_ct(:,jk,:)) 80 79 END DO 81 82 DO ji=1,jpi ! i-loop 80 DO ji=fs_2,fs_jpim1 ! i-loop 83 81 ! Only process this horizontal point (ji,jj) if number of layers exceeds 1 84 IF (mbkt(ji,jj)>1) THEN ! Level check85 k_floor=mbkt(ji,jj)82 k_floor = mbkt(ji,jj) 83 IF (k_floor > 1) THEN 86 84 ! Linearly interpolate to velocities at the interfaces between layers 87 85 ! Note: 88 ! - interface k sits between cell centre k and k -1,89 ! - k [1,jpk ] increases downwards86 ! - interface k sits between cell centre k and k+1 (k=0 for surface) 87 ! - k [1,jpkm1] increases downwards 90 88 ! - upward velocity is positive, downward velocity is negative 91 zwgt_if(1,:)=0._wp ! surface 92 w_if(1,:)=0._wp ! surface 93 zwgt_if(2:k_floor,:)=spread(& 94 fse3t(ji,jj,2:k_floor)/ (fse3t(ji,jj,1:k_floor-1)+fse3t(ji,jj,2:k_floor))& 95 ,2,jp_fabm) 96 w_if(2:k_floor,:) = zwgt_if(2:k_floor,:)*w_ct(ji,1:k_floor-1,:)& 97 +(1._wp-zwgt_if(1:k_floor-1,:))*w_ct(ji,2:k_floor,:) 98 zwgt_if(k_floor+1:,:)=0._wp ! sea floor and below 99 w_if(k_floor+1:,:)=0._wp ! sea floor and below 89 h(1:k_floor) = fse3t(ji,jj,1:k_floor) 90 zwgt_if(1:k_floor-1) = h(2:k_floor) / (h(1:k_floor-1) + h(2:k_floor)) 100 91 101 92 ! Advect: 102 93 DO jn=1,jp_fabm ! State loop 103 ! get maximum Courant number: 104 c_no(2:k_floor)=abs(w_if(2:k_floor,jn))*z2dt/ & 105 ( 0.5_wp*(fse3t(ji,jj,2:k_floor) + & 106 fse3t(ji,ji,1:k_floor-1)) ) 107 cmax_no=MAXVAL(c_no(2:k_floor)) 108 109 ! number of iterations: 110 n_iter=min(n_itermax,int(cmax_no)+1) 111 IF (ln_ctl.AND.(n_iter .gt. 1)) THEN 112 WRITE(numout,*) 'vertical_movement_fabm():' 113 WRITE(numout,*) ' Maximum Courant number is ',cmax_no,'.' 114 WRITE(numout,*) ' ',n_iter,' iterations used for vertical advection.' 115 ENDIF 116 117 ! effective Courant number: 118 c_no=c_no/n_iter 119 120 tr_it(1:k_floor)=trb(ji,jj,1:k_floor,jp_fabm_m1+jn) 121 DO n_count=1,n_iter ! Iterative loop 122 !Compute slope ratio 123 IF (k_floor.gt.2) THEN !More than 2 vertical wet points 124 IF (k_floor.gt.3) THEN 125 WHERE (w_if(3:k_floor-1,jn).ge.0._wp) !upward movement 126 tr_u(3:k_floor-1)=tr_it(4:k_floor) 127 tr_c(3:k_floor-1)=tr_it(3:k_floor-1) 128 tr_d(3:k_floor-1)=tr_it(2:k_floor-2) 129 ELSEWHERE !downward movement 130 tr_u(3:k_floor-1)=tr_it(1:k_floor-3) 131 tr_c(3:k_floor-1)=tr_it(2:k_floor-2) 132 tr_d(3:k_floor-1)=tr_it(3:k_floor-1) 133 ENDWHERE 134 ENDIF 135 IF (w_if(2,jn).ge.0._wp) THEN 136 tr_u(2)=tr_it(3) 137 tr_c(2)=tr_it(2) 138 tr_d(2)=tr_it(1) 139 ELSE 140 tr_u(2)=tr_it(1) 141 tr_c(2)=tr_it(1) 142 tr_d(2)=tr_it(2) 143 ENDIF 144 IF (w_if(k_floor,jn).ge.0._wp) THEN 145 tr_u(k_floor)=tr_it(k_floor) 146 tr_c(k_floor)=tr_it(k_floor) 147 tr_d(k_floor)=tr_it(k_floor-1) 148 ELSE 149 tr_u(k_floor)=tr_it(k_floor-2) 150 tr_c(k_floor)=tr_it(k_floor-1) 151 tr_d(k_floor)=tr_it(k_floor) 152 ENDIF 153 ELSE !only 2 vertical wet points, i.e. only 1 interface 154 IF (w_if(k_floor,jn).ge.0._wp) THEN 155 tr_u(2)=tr_it(2) 156 tr_c(2)=tr_it(2) 157 tr_d(2)=tr_it(1) 158 ELSE 159 tr_u(2)=tr_it(1) 160 tr_c(2)=tr_it(1) 161 tr_d(2)=tr_it(2) 162 ENDIF 163 ENDIF 164 WHERE (abs(tr_d(2:k_floor)-tr_c(2:k_floor)).gt.1.e-10_wp) 165 tr_slope(2:k_floor)= & 166 (tr_c(2:k_floor)-tr_u(2:k_floor))/ & 167 (tr_d(2:k_floor)-tr_c(2:k_floor)) 168 ELSEWHERE 169 tr_slope(2:k_floor)=SIGN(1._wp,w_if(2:k_floor,jn))* & 170 (tr_c(2:k_floor)-tr_u(2:k_floor))*1.e10_wp 171 ENDWHERE 172 173 !QUICKEST flux limiter: 174 x_fac(2:k_floor)=(1._wp-2._wp*c_no(2:k_floor))/6._wp 175 phi_lim(2:k_floor)=(0.5_wp+x_fac(2:k_floor)) + & 176 (0.5_wp-x_Fac(2:k_floor))*tr_slope(2:k_floor) 177 flux_lim(2:k_floor)=max( 0._wp, & 178 min( phi_lim(2:k_floor),2._wp/(1._wp-c_no(2:k_floor)), & 179 2._wp*tr_slope(2:k_floor)/(c_no(2:k_floor)+1.e-10_wp)) ) 180 181 ! Compute limited flux: 182 flux_if(2:k_floor,jn) = w_if(2:k_floor,jn)* & 183 ( tr_c(2:k_floor) + & 184 0.5_wp*flux_lim(2:k_floor)*(1._wp-c_no(2:k_floor))* & 185 (tr_d(2:k_floor)-tr_c(2:k_floor)) ) 186 187 ! Compute pseudo update for trend aggregation: 188 tr_it(1:k_floor-1) = tr_it(1:k_floor-1) + & 189 z2dt/float(n_iter)/fse3t(ji,jj,1:k_floor-1)* & 190 flux_if(2:k_floor,jn) 191 tr_it(2:k_floor) = tr_it(2:k_floor) - & 192 z2dt/float(n_iter)/fse3t(ji,jj,2:k_floor)* & 193 flux_if(2:k_floor,jn) 194 195 ENDDO ! Iterative loop 196 197 ! Estimate rate of change from pseudo state updates (source 198 ! splitting): 199 tra(ji,jj,1:k_floor,jp_fabm_m1+jn) = & 200 tra(ji,jj,1:k_floor,jp_fabm_m1+jn) + & 201 (tr_it(1:k_floor) - trb(ji,jj,1:k_floor,jp_fabm_m1+jn))/z2dt 202 #if defined key_trdtrc && defined key_iomput 203 IF( lk_trdtrc .AND. ln_trdtrc( jp_fabm_m1+jn ) ) THEN 204 tr_vmv(ji,jj,1:k_floor,jn)=(tr_it(1:k_floor) - trb(ji,jj,1:k_floor,jn))/z2dt 94 IF (ALL(w_ct(ji,1:k_floor,jn) == 0._wp)) CYCLE 95 96 ! Compute velocities at interfaces 97 w_if(1:k_floor-1) = zwgt_if(1:k_floor-1) * w_ct(ji,1:k_floor-1,jn) + (1._wp - zwgt_if(1:k_floor-1)) * w_ct(ji,2:k_floor,jn) 98 99 ! Compute change (per volume) due to vertical movement per layer 100 IF (method == 1) THEN 101 CALL advect_1(k_floor, trn(ji,jj,1:k_floor,jp_fabm_m1+jn), w_if(1:k_floor-1), h(1:k_floor), z2dt, dc(1:k_floor)) 102 ELSE 103 CALL advect_3(k_floor, trb(ji,jj,1:k_floor,jp_fabm_m1+jn), w_if(1:k_floor-1), h(1:k_floor), z2dt, dc(1:k_floor)) 205 104 END IF 105 106 ! Incorporate change due to vertical movement in sources-sinks 107 tra(ji,jj,1:k_floor,jp_fabm_m1+jn) = tra(ji,jj,1:k_floor,jp_fabm_m1+jn) + dc(1:k_floor) 108 109 #if defined key_trdtrc && defined key_iomput 110 ! Store change due to vertical movement as diagnostic 111 IF( lk_trdtrc .AND. ln_trdtrc( jp_fabm_m1+jn)) tr_vmv(ji,jj,1:k_floor,jn) = dc(1:k_floor) 206 112 #endif 207 113 ENDDO ! State loop … … 209 115 END DO ! i-loop 210 116 END DO ! j-loop 117 211 118 #if defined key_trdtrc && defined key_iomput 212 119 DO jn=1,jp_fabm ! State loop … … 220 127 END SUBROUTINE compute_vertical_movement 221 128 129 SUBROUTINE advect_1(nk, c, w, h, dt, trend) 130 INTEGER, INTENT(IN) :: nk 131 REAL(wp), INTENT(IN) :: c(1:nk) 132 REAL(wp), INTENT(IN) :: w(1:nk-1) 133 REAL(wp), INTENT(IN) :: h(1:nk) 134 REAL(wp), INTENT(IN) :: dt 135 REAL(wp), INTENT(OUT) :: trend(1:nk) 136 137 REAL(wp) :: flux(0:nk) 138 INTEGER :: jk 139 ! Compute fluxes (per surface area) over at interfaces (remember: positive for upwards) 140 flux(0) = 0._wp 141 DO jk=1,nk-1 ! k-loop 142 IF (w(jk) > 0) THEN 143 ! Upward movement (source layer is jk+1) 144 flux(jk) = min(w(jk), h(jk+1)/dt) * c(jk+1) 145 ELSE 146 ! Downward movement (source layer is jk) 147 flux(jk) = max(w(jk), -h(jk)/dt) * c(jk) 148 END IF 149 END DO 150 flux(nk) = 0._wp 151 trend = (flux(1:nk) - flux(0:nk-1)) / h 152 END SUBROUTINE 153 154 SUBROUTINE advect_3(nk, c_old, w, h, dt, trend) 155 INTEGER, INTENT(IN) :: nk 156 REAL(wp), INTENT(IN) :: c_old(1:nk) 157 REAL(wp), INTENT(IN) :: w(1:nk-1) 158 REAL(wp), INTENT(IN) :: h(1:nk) 159 REAL(wp), INTENT(IN) :: dt 160 REAL(wp), INTENT(OUT) :: trend(1:nk) 161 162 INTEGER, PARAMETER :: n_itermax=100 163 REAL(wp) :: cmax_no 164 REAL(wp) :: cfl(1:nk-1) 165 INTEGER :: n_iter, n_count, jk 166 REAL(wp) :: c(1:nk) 167 REAL(wp) :: tr_u(1:nk-1) 168 REAL(wp) :: tr_c(1:nk-1) 169 REAL(wp) :: tr_d(1:nk-1) 170 REAL(wp) :: delta_tr_u(1:nk-1) 171 REAL(wp) :: delta_tr(1:nk-1) 172 REAL(wp) :: ratio(1:nk-1) 173 REAL(wp) :: x_fac(1:nk-1) 174 REAL(wp) :: phi_lim(1:nk-1) 175 REAL(wp) :: limiter(1:nk-1) 176 REAL(wp) :: flux_if(1:nk-1) 177 178 c(:) = c_old(:) 179 180 ! get maximum Courant number: 181 cfl = ABS(w) * dt / (0.5_wp * (h(2:nk) + h(1:nk-1))) 182 cmax_no = MAXVAL(cfl) 183 184 ! number of iterations: 185 n_iter = MIN(n_itermax, INT(cmax_no) + 1) 186 IF (ln_ctl.AND.(n_iter .gt. 1)) THEN 187 WRITE(numout,*) 'compute_vertical_movement::advect_3():' 188 WRITE(numout,*) ' Maximum Courant number is ',cmax_no,'.' 189 WRITE(numout,*) ' ',n_iter,' iterations used for vertical advection.' 190 ENDIF 191 192 ! effective Courant number: 193 cfl = cfl/n_iter 194 195 DO n_count=1,n_iter ! Iterative loop 196 ! Determine tracer concentration at 1.5 upstream (tr_u), 0.5 upstream (tr_c), 0.5 downstream (tr_d) from interface 197 IF (nk.gt.2) THEN 198 ! More than 2 vertical wet points 199 IF (nk.gt.3) THEN 200 WHERE (w(2:nk-2).ge.0._wp) 201 !upward movement 202 tr_u(2:nk-2)=c(4:nk) 203 tr_c(2:nk-2)=c(3:nk-1) 204 tr_d(2:nk-2)=c(2:nk-2) 205 ELSEWHERE 206 ! downward movement 207 tr_u(2:nk-2)=c(1:nk-3) 208 tr_c(2:nk-2)=c(2:nk-2) 209 tr_d(2:nk-2)=c(3:nk-1) 210 ENDWHERE 211 ENDIF 212 213 ! Interface between surface layer and the next 214 IF (w(1).ge.0._wp) THEN 215 ! upward movement 216 tr_u(1)=c(3) 217 tr_c(1)=c(2) 218 tr_d(1)=c(1) 219 ELSE 220 ! downward movement 221 tr_u(1)=c(1) 222 tr_c(1)=c(1) 223 tr_d(1)=c(2) 224 ENDIF 225 226 ! Interface between bottom layer and the previous 227 IF (w(nk-1).ge.0._wp) THEN 228 ! upward movement 229 tr_u(nk-1)=c(nk) 230 tr_c(nk-1)=c(nk) 231 tr_d(nk-1)=c(nk-1) 232 ELSE 233 ! downward movement 234 tr_u(nk-1)=c(nk-2) 235 tr_c(nk-1)=c(nk-1) 236 tr_d(nk-1)=c(nk) 237 ENDIF 238 ELSE 239 ! only 2 vertical wet points, i.e. only 1 interface 240 IF (w(1).ge.0._wp) THEN 241 ! upward movement 242 tr_u(1)=c(2) 243 tr_c(1)=c(2) 244 tr_d(1)=c(1) 245 ELSE 246 ! downward movement 247 tr_u(1)=c(1) 248 tr_c(1)=c(1) 249 tr_d(1)=c(2) 250 ENDIF 251 ENDIF 252 253 delta_tr_u = tr_c - tr_u 254 delta_tr = tr_d - tr_c 255 WHERE (delta_tr * delta_tr_u > 0._wp) 256 ! Monotonic function over tr_u, tr_c, r_d 257 258 ! Compute slope ratio 259 ratio = delta_tr_u / delta_tr 260 261 ! QUICKEST flux limiter 262 x_fac = (1._wp - 2._wp * cfl) / 6._wp 263 phi_lim = (0.5_wp + x_fac) + (0.5_wp - x_fac) * ratio 264 limiter = MIN(phi_lim, 2._wp / (1._wp - cfl), 2._wp * ratio / (cfl + 1.e-10_wp)) 265 266 ! Compute limited flux 267 flux_if = w * (tr_c + 0.5_wp * limiter * (1._wp - cfl) * delta_tr) 268 ELSEWHERE 269 ! Non-monotonic, use 1st order upstream 270 flux_if = w * tr_c 271 ENDWHERE 272 273 ! Compute pseudo update for trend aggregation: 274 c(1:nk-1) = c(1:nk-1) + dt / real(n_iter, wp) / h(1:nk-1) * flux_if 275 c(2:nk) = c(2:nk) - dt / real(n_iter, wp) / h(2:nk) * flux_if 276 277 ENDDO ! Iterative loop 278 279 ! Estimate rate of change from pseudo state updates (source splitting): 280 trend = (c - c_old) / dt 281 END SUBROUTINE 282 222 283 #endif 223 284 END MODULE -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90
r10162 r15480 14 14 USE trc ! passive tracers common variables 15 15 USE iom ! I/O manager 16 USE trdtrc_oce 16 17 17 18 IMPLICIT NONE … … 45 46 #endif 46 47 CHARACTER (len=20) :: cltra 47 INTEGER :: jn,jk ! JC TODO jk defined here but may not be used48 INTEGER :: jn,jk 48 49 !!--------------------------------------------------------------------- 49 50 … … 60 61 trpool(:,:,:) = 0.5 * ( trn(:,:,:,jn) * fse3t_a(:,:,:) + & 61 62 trb_temp(:,:,:,jn) * fse3t(:,:,:) ) 62 cltra = TRIM( ctrcnm(jn) )//" e3t" ! depth integrated output63 cltra = TRIM( ctrcnm(jn) )//"_e3t" ! depth integrated output 63 64 IF( kt == nittrc000 ) write(6,*)'output pool ',cltra 64 65 DO jk = 1, jpk -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc.F90
r10162 r15480 103 103 cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 104 104 ! +++>>>FABM 105 #if defined key_tracer_budget 105 #if defined key_tracer_budget && defined key_fabm 106 106 ! for outputting depth integrated 107 107 SELECT CASE( ktrd ) -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/NEMO/TOP_SRC/trc.F90
r10728 r15480 111 111 ! +++ FABM 112 112 LOGICAL :: llinit=.FALSE. !: read in a file or not 113 #if defined key_fabm113 #if defined key_my_trc || key_fabm 114 114 LOGICAL :: llsbc=.FALSE. !: read in a file or not 115 115 LOGICAL :: llcbc=.FALSE. !: read in a file or not … … 257 257 ! FABM <<<--- 258 258 ! +++>>> FABM 259 #if defined key_ fabm259 #if defined key_my_trc || defined key_fabm 260 260 ! FABM <<<+++ 261 261 & ln_trc_sbc(jptra) , ln_trc_cbc(jptra) , ln_trc_obc(jptra) , & -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/NEMO/TOP_SRC/trcbdy.F90
r10270 r15480 62 62 CASE('frs') 63 63 CALL bdy_trc_frs( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), kt ) 64 CASE('frs_damped') 65 CALL bdy_trc_frs_damped( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), kt ) 64 66 CASE('specified') 65 67 CALL bdy_trc_spe( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), kt ) … … 120 122 ! 121 123 END SUBROUTINE bdy_trc_frs 124 125 SUBROUTINE bdy_trc_frs_damped ( jn, idx, dta, kt ) 126 !!---------------------------------------------------------------------- 127 !! *** SUBROUTINE bdy_trc_frs *** 128 !! 129 !! ** Purpose : Apply the Flow Relaxation Scheme for tracers at open boundaries. 130 !! 131 !! Reference : Engedahl H., 1995, Tellus, 365-382. 132 !!---------------------------------------------------------------------- 133 INTEGER, INTENT(in) :: kt 134 INTEGER, INTENT(in) :: jn ! Tracer index 135 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 136 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 137 !! 138 REAL(wp) :: zwgt ! boundary weight 139 INTEGER :: ib, ik, igrd ! dummy loop indices 140 INTEGER :: ii, ij ! 2D addresses 141 !!---------------------------------------------------------------------- 142 ! 143 IF( nn_timing == 1 ) CALL timing_start('bdy_trc_frs') 144 ! 145 igrd = 1 ! Everything is at T-points here 146 DO ib = 1, idx%nblen(igrd) 147 DO ik = 1, jpkm1 148 ii = idx%nbi(ib,igrd) 149 ij = idx%nbj(ib,igrd) 150 zwgt = idx%nbw(ib,igrd)* rdttrc(ik) / 86400.d0 ! damping with a timescale of day 151 tra(ii,ij,ik,jn) = ( tra(ii,ij,ik,jn) + zwgt * ( ( dta%trc(ib,ik) * dta%rn_fac) & 152 & - tra(ii,ij,ik,jn) ) ) * tmask(ii,ij,ik) 153 END DO 154 END DO 155 ! 156 IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 157 ! 158 IF( nn_timing == 1 ) CALL timing_stop('bdy_trc_frs') 159 ! 160 END SUBROUTINE bdy_trc_frs_damped 161 122 162 123 163 SUBROUTINE bdy_trc_spe( jn, idx, dta, kt ) -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r10162 r15480 76 76 ! +++>>> FABM 77 77 ! Allow FABM to update numbers of biogeochemical tracers, diagnostics (jptra etc.) 78 IF( lk_fabm ) CALL nemo_fabm_ init78 IF( lk_fabm ) CALL nemo_fabm_configure 79 79 ! FABM <<<+++ 80 80 … … 163 163 ! FABM +++>>> 164 164 ! Initialisation of FABM diagnostics and tracer boundary conditions (so that you can use initial condition as boundary) 165 IF( lk_fabm ) THEN 166 wndm=0._wp !uninitiased field at this point 167 qsr=0._wp !uninitiased field at this point 168 CALL compute_fabm ! only needed to set-up diagnostics 169 CALL trc_bc_init(jptra) 170 ENDIF 165 IF( lk_my_trc .or. lk_fabm ) CALL trc_bc_init(jptra) 171 166 ! FABM <<<+++ 172 167 173 168 tra(:,:,:,:) = 0._wp 174 169 IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav ) & ! Partial steps: before horizontal gradient of passive -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/NEMO/TOP_SRC/trcnam.F90
r10162 r15480 321 321 sn_tracer(:)%llinit = .FALSE. 322 322 sn_tracer(:)%llsave = .FALSE. 323 #if defkey_fabm323 #if defined key_my_trc || defined key_fabm 324 324 sn_tracer(:)%llsbc = .FALSE. 325 325 sn_tracer(:)%llcbc = .FALSE. 326 326 sn_tracer(:)%llcbc = .FALSE. 327 sn_tracer(:)%clsname = 'NONAME' 327 328 #endif 328 329 … … 335 336 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc in configuration namelist', lwp ) 336 337 IF(lwm) WRITE ( numont, namtrc ) 338 339 ! +++>>> FABM 340 if (lk_fabm) CALL trc_nam_fabm_override(sn_tracer) 341 ! FABM <<<+++ 337 342 338 343 DO jn = 1, jptra … … 345 350 ! FABM <<<--- 346 351 ! +++>>> FABM 347 #if defined key_ fabm352 #if defined key_my_trc || defined key_fabm 348 353 ! FABM <<<+++ 349 354 ln_trc_sbc(jn) = sn_tracer(jn)%llsbc … … 354 359 END DO 355 360 356 ! +++>>> FABM357 if (lk_fabm) CALL trc_nam_fabm_override358 ! FABM <<<+++359 361 END SUBROUTINE trc_nam_trc 360 362 -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/SETTE/all_functions.sh
r8058 r15480 79 79 # ========== 80 80 # 81 # $Id : all_functions.sh 6224 2016-01-07 17:02:43Z acc$81 # $Id$ 82 82 # 83 83 # * creation -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/TOOLS/COMPILE/Fcheck_archfile.sh
r8058 r15480 52 52 # ========== 53 53 # 54 # $Id : Fcheck_archfile.sh 4162 2013-11-07 10:19:49Z cetlod$54 # $Id$ 55 55 # 56 56 # -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/TOOLS/COMPILE/Fcheck_config.sh
r8058 r15480 58 58 # ========== 59 59 # 60 # $Id : Fcheck_config.sh 4990 2014-12-15 16:42:49Z timgraham$60 # $Id$ 61 61 # 62 62 # -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/TOOLS/COMPILE/Fcheck_script.sh
r8058 r15480 45 45 # ========== 46 46 # 47 # $Id : Fcheck_script.sh 3294 2012-01-28 16:44:18Z rblod$47 # $Id$ 48 48 # 49 49 # -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/TOOLS/COMPILE/Fclean_var.sh
r8058 r15480 45 45 # ========== 46 46 # 47 # $Id : Fclean_var.sh 4990 2014-12-15 16:42:49Z timgraham$47 # $Id$ 48 48 # 49 49 # -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/TOOLS/COMPILE/Fcopy_dir.sh
r8058 r15480 46 46 # ========== 47 47 # 48 # $Id : Fcopy_dir.sh 4990 2014-12-15 16:42:49Z timgraham$48 # $Id$ 49 49 # 50 50 # -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/TOOLS/COMPILE/Fgo_to_TOOLS.sh
r8058 r15480 45 45 # ========== 46 46 # 47 # $Id : Fgo_to_TOOLS.sh 3294 2012-01-28 16:44:18Z rblod$47 # $Id$ 48 48 # 49 49 # -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/TOOLS/COMPILE/Flist_archfile.sh
r8058 r15480 48 48 # ========== 49 49 # 50 # $Id : Flist_archfile.sh 4148 2013-11-04 12:54:28Z cetlod$50 # $Id$ 51 51 # 52 52 # -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/TOOLS/COMPILE/Fmake_WORK.sh
r8058 r15480 57 57 # ========== 58 58 # 59 # $Id : Fmake_WORK.sh 4990 2014-12-15 16:42:49Z timgraham$59 # $Id$ 60 60 # 61 61 # -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/TOOLS/COMPILE/Fmake_bld.sh
r8058 r15480 51 51 # ========== 52 52 # 53 # $Id : Fmake_bld.sh 3294 2012-01-28 16:44:18Z rblod$53 # $Id$ 54 54 # 55 55 # -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/TOOLS/COMPILE/Fmake_config.sh
r8058 r15480 50 50 # ========== 51 51 # 52 # $Id : Fmake_config.sh 6224 2016-01-07 17:02:43Z acc$52 # $Id$ 53 53 # 54 54 # -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/TOOLS/COMPILE/Fprep_agrif.sh
r8058 r15480 47 47 # ========== 48 48 # 49 # $Id : Fprep_agrif.sh 6204 2016-01-04 13:47:06Z cetlod$49 # $Id$ 50 50 # 51 51 # -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/TOOLS/COMPILE/Fread_dir.sh
r8058 r15480 45 45 # ========== 46 46 # 47 # $Id : Fread_dir.sh 3294 2012-01-28 16:44:18Z rblod$47 # $Id$ 48 48 # 49 49 # -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/TOOLS/COMPILE/bld.cfg
r8058 r15480 55 55 bld::excl_dep use::mod_oasis 56 56 bld::excl_dep use::mkl_dfti 57 # +++>>> FABM 58 bld::excl_dep use::fabm 59 bld::excl_dep use::fabm_types 60 bld::excl_dep use::fabm_driver 61 bld::excl_dep use::fabm_version 62 # FABM <<<+++ 57 63 # Don't generate interface files 58 64 bld::tool::geninterface none -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/TOOLS/COMPILE/bldxag.cfg
r8058 r15480 51 51 bld::excl_dep use::mod_oasis 52 52 bld::excl_dep use::mkl_dfti 53 # +++>>> FABM 54 bld::excl_dep use::fabm 55 bld::excl_dep use::fabm_types 56 bld::excl_dep use::fabm_driver 57 bld::excl_dep use::fabm_version 58 # <<<+++ FABM 53 59 # Don't generate interface files 54 60 bld::tool::geninterface none -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/TOOLS/MISCELLANEOUS/chk_iomput.sh
r8058 r15480 1 1 #!/bin/bash 2 2 #------------------------------------------------ 3 #$Id : chk_iomput.sh 4162 2013-11-07 10:19:49Z cetlod$3 #$Id$ 4 4 #------------------------------------------------ 5 5 # -
NEMO/branches/UKMO/AMM15_v3_6_STABLE_new_ersem/NEMOGCM/TOOLS/maketools
r8058 r15480 64 64 # ========== 65 65 # 66 # $Id : maketools 4363 2014-01-22 11:11:47Z rfurner$66 # $Id$ 67 67 # 68 68 #
Note: See TracChangeset
for help on using the changeset viewer.