Changeset 10850
- Timestamp:
- 2019-04-08T15:00:20+02:00 (5 years ago)
- Location:
- branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM
- Files:
-
- 15 edited
- 5 copied
-
CONFIG/SHARED/namelist_ref (modified) (1 diff)
-
NEMO/OPA_SRC/ASM/asmbgc.F90 (copied) (copied from branches/UKMO/AMM15_v3_6_STABLE_package_collate/NEMOGCM/NEMO/OPA_SRC/ASM/asmbgc.F90)
-
NEMO/OPA_SRC/ASM/asmbkg.F90 (modified) (4 diffs)
-
NEMO/OPA_SRC/ASM/asminc.F90 (modified) (15 diffs)
-
NEMO/OPA_SRC/ASM/asmpar.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/ASM/asmpco2bal.F90 (copied) (copied from branches/UKMO/AMM15_v3_6_STABLE_package_collate/NEMOGCM/NEMO/OPA_SRC/ASM/asmpco2bal.F90)
-
NEMO/OPA_SRC/ASM/asmphyto2dbal_ersem.F90 (copied) (copied from branches/UKMO/AMM15_v3_6_STABLE_package_collate/NEMOGCM/NEMO/OPA_SRC/ASM/asmphyto2dbal_ersem.F90)
-
NEMO/OPA_SRC/ASM/asmphyto2dbal_hadocc.F90 (copied) (copied from branches/UKMO/AMM15_v3_6_STABLE_package_collate/NEMOGCM/NEMO/OPA_SRC/ASM/asmphyto2dbal_hadocc.F90)
-
NEMO/OPA_SRC/ASM/asmphyto2dbal_medusa.F90 (copied) (copied from branches/UKMO/AMM15_v3_6_STABLE_package_collate/NEMOGCM/NEMO/OPA_SRC/ASM/asmphyto2dbal_medusa.F90)
-
NEMO/OPA_SRC/DIA/dia25h.F90 (modified) (10 diffs)
-
NEMO/OPA_SRC/DIA/diaopfoam.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/DIA/diatmb.F90 (modified) (3 diffs)
-
NEMO/OPA_SRC/ZDF/zdftmx.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/nemogcm.F90 (modified) (3 diffs)
-
NEMO/OPA_SRC/step.F90 (modified) (1 diff)
-
NEMO/TOP_SRC/FABM/par_fabm.F90 (modified) (1 diff)
-
NEMO/TOP_SRC/FABM/trcini_fabm.F90 (modified) (6 diffs)
-
NEMO/TOP_SRC/FABM/trcsms_fabm.F90 (modified) (3 diffs)
-
NEMO/TOP_SRC/trc.F90 (modified) (2 diffs)
-
NEMO/TOP_SRC/trcbc.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/CONFIG/SHARED/namelist_ref
r10479 r10850 1281 1281 &nam_asminc ! assimilation increments ('key_asminc') 1282 1282 !----------------------------------------------------------------------- 1283 ln_bkgwri = .false. ! Logical switch for writing out background state 1284 ln_trainc = .false. ! Logical switch for applying tracer increments 1285 ln_dyninc = .false. ! Logical switch for applying velocity increments 1286 ln_sshinc = .false. ! Logical switch for applying SSH increments 1287 ln_asmdin = .false. ! Logical switch for Direct Initialization (DI) 1288 ln_asmiau = .false. ! Logical switch for Incremental Analysis Updating (IAU) 1289 nitbkg = 0 ! Timestep of background in [0,nitend-nit000-1] 1290 nitdin = 0 ! Timestep of background for DI in [0,nitend-nit000-1] 1291 nitiaustr = 1 ! Timestep of start of IAU interval in [0,nitend-nit000-1] 1292 nitiaufin = 15 ! Timestep of end of IAU interval in [0,nitend-nit000-1] 1293 niaufn = 0 ! Type of IAU weighting function 1294 ln_salfix = .false. ! Logical switch for ensuring that the sa > salfixmin 1295 salfixmin = -9999 ! Minimum salinity after applying the increments 1296 nn_divdmp = 0 ! Number of iterations of divergence damping operator 1283 ln_bkgwri = .false. ! Logical switch for writing out background state 1284 ln_balwri = .false. ! Logical switch for writing out balancing increments 1285 ln_trainc = .false. ! Logical switch for applying tracer increments 1286 ln_dyninc = .false. ! Logical switch for applying velocity increments 1287 ln_sshinc = .false. ! Logical switch for applying SSH increments 1288 ln_asmdin = .false. ! Logical switch for Direct Initialization (DI) 1289 ln_asmiau = .false. ! Logical switch for Incremental Analysis Updating (IAU) 1290 ln_phytobal = .false. ! Logical switch for phytoplankton multivariate balancing 1291 ln_slchltotinc = .false. ! Logical switch for applying slchltot increments 1292 ln_slchldiainc = .false. ! Logical switch for applying slchldia increments 1293 ln_slchlnoninc = .false. ! Logical switch for applying slchlnon increments 1294 ln_slchlnaninc = .false. ! Logical switch for applying slchlnan increments 1295 ln_slchlpicinc = .false. ! Logical switch for applying slchlpic increments 1296 ln_slchldininc = .false. ! Logical switch for applying slchldin increments 1297 ln_schltotinc = .false. ! Logical switch for applying schltot increments 1298 ln_slphytotinc = .false. ! Logical switch for applying slphytot increments 1299 ln_slphydiainc = .false. ! Logical switch for applying slphydia increments 1300 ln_slphynoninc = .false. ! Logical switch for applying slphynon increments 1301 ln_sfco2inc = .false. ! Logical switch for applying sfCO2 increments 1302 ln_spco2inc = .false. ! Logical switch for applying spCO2 increments 1303 ln_plchltotinc = .false. ! Logical switch for applying plchltot increments 1304 ln_pchltotinc = .false. ! Logical switch for applying pchltot increments 1305 ln_pno3inc = .false. ! Logical switch for applying pno3 increments 1306 ln_psi4inc = .false. ! Logical switch for applying psi4 increments 1307 ln_ppo4inc = .false. ! Logical switch for applying ppo4 increments 1308 ln_pdicinc = .false. ! Logical switch for applying pdic increments 1309 ln_palkinc = .false. ! Logical switch for applying palk increments 1310 ln_pphinc = .false. ! Logical switch for applying pph increments 1311 ln_po2inc = .false. ! Logical switch for applying po2 increments 1312 nitbkg = 0 ! Timestep of background in [0,nitend-nit000-1] 1313 nitdin = 0 ! Timestep of background for DI in [0,nitend-nit000-1] 1314 nitiaustr = 1 ! Timestep of start of IAU interval in [0,nitend-nit000-1] 1315 nitiaufin = 15 ! Timestep of end of IAU interval in [0,nitend-nit000-1] 1316 niaufn = 0 ! Type of IAU weighting function 1317 ln_salfix = .false. ! Logical switch for ensuring that the sa > salfixmin 1318 salfixmin = -9999 ! Minimum salinity after applying the increments 1319 nn_divdmp = 0 ! Number of iterations of divergence damping operator 1320 mld_choice_bgc = 1 ! MLD criterion to use for biogeochemistry assimilation 1321 rn_maxchlinc = -999.0 ! maximum absolute non-log chlorophyll increment from ocean colour assimilation 1322 ! <= 0 implies no maximum applied (switch turned off) 1323 ! > 0 implies maximum absolute chl increment capped at this value 1297 1324 / 1298 1325 !----------------------------------------------------------------------- -
branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90
r9180 r10850 51 51 #endif 52 52 USE asminc, ONLY: ln_avgbkg 53 #if defined key_top 54 USE asmbgc, ONLY: asm_bgc_bkg_alloc, & 55 & asm_bgc_bkg_tavg, & 56 & asm_bgc_bkg_wri 57 #endif 53 58 IMPLICIT NONE 54 59 PRIVATE … … 137 142 138 143 numtimes_tavg = REAL ( nitavgbkg_r - nn_it000 + 1 ) 139 ENDIF 144 ENDIF 145 146 #if defined key_top 147 ! Allocate BGC average arrays whatever, to save code repetition later 148 IF ( kt == ( nn_it000 - 1) ) THEN 149 CALL asm_bgc_bkg_alloc 150 ENDIF 151 #endif 140 152 141 153 ! If creating an averaged assim bkg, sum the contribution every timestep … … 154 166 #if defined key_zdftke 155 167 en_tavg(:,:,:) = en_tavg(:,:,:) + en(:,:,:) / numtimes_tavg 168 #endif 169 #if defined key_top 170 CALL asm_bgc_bkg_tavg( kt, numtimes_tavg ) 156 171 #endif 157 172 ENDIF … … 222 237 ENDIF 223 238 239 #if defined key_top 240 CALL asm_bgc_bkg_wri( kt, inum, ln_avgbkg ) 241 #endif 224 242 CALL iom_close( inum ) 225 243 -
branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90
r9537 r10850 52 52 USE bdy_oce, ONLY: bdytmask 53 53 #endif 54 USE asmbgc ! Biogeochemistry assimilation 54 55 55 56 IMPLICIT NONE … … 62 63 PUBLIC ssh_asm_inc !: Apply the SSH increment 63 64 PUBLIC seaice_asm_inc !: Apply the seaice increment 65 PUBLIC bgc_asm_inc !: Apply the biogeochemistry increments 64 66 65 67 #if defined key_asminc … … 76 78 LOGICAL, PUBLIC :: ln_sshinc = .FALSE. !: No sea surface height assimilation increment 77 79 LOGICAL, PUBLIC :: ln_seaiceinc !: No sea ice concentration increment 80 LOGICAL, PUBLIC :: lk_bgcinc = .FALSE. !: No biogeochemistry increments 78 81 LOGICAL, PUBLIC :: ln_salfix = .FALSE. !: Apply minimum salinity check 79 82 LOGICAL, PUBLIC :: ln_temnofreeze = .FALSE. !: Don't allow the temperature to drop below freezing … … 161 164 ! so only apply surft increments. 162 165 !! 163 NAMELIST/nam_asminc/ ln_bkgwri, ln_avgbkg, 166 NAMELIST/nam_asminc/ ln_bkgwri, ln_avgbkg, ln_balwri, & 164 167 & ln_trainc, ln_dyninc, ln_sshinc, & 168 & ln_phytobal, ln_slchltotinc, ln_slchldiainc, & 169 & ln_slchlnaninc, ln_slchlpicinc, ln_slchldininc, & 170 & ln_slchlnoninc, ln_schltotinc, ln_slphytotinc, & 171 & ln_slphydiainc, ln_slphynoninc, ln_spco2inc, & 172 & ln_sfco2inc, ln_plchltotinc, ln_pchltotinc, & 173 & ln_pno3inc, ln_psi4inc, ln_pdicinc, ln_palkinc, & 174 & ln_pphinc, ln_po2inc, ln_ppo4inc, & 165 175 & ln_asmdin, ln_asmiau, & 166 176 & nitbkg, nitdin, nitiaustr, nitiaufin, niaufn, & 167 & ln_salfix, salfixmin, nn_divdmp, nitavgbkg, mld_choice 177 & ln_salfix, salfixmin, nn_divdmp, nitavgbkg, & 178 & mld_choice, mld_choice_bgc, rn_maxchlinc 168 179 !!---------------------------------------------------------------------- 169 180 … … 205 216 WRITE(numout,*) 'asm_inc_init : Assimilation increment initialization :' 206 217 WRITE(numout,*) '~~~~~~~~~~~~' 207 WRITE(numout,*) ' Namelist nam asm: set assimilation increment parameters'218 WRITE(numout,*) ' Namelist nam_asminc : set assimilation increment parameters' 208 219 WRITE(numout,*) ' Logical switch for writing out background state ln_bkgwri = ', ln_bkgwri 209 220 WRITE(numout,*) ' Logical switch for writing mean background state ln_avgbkg = ', ln_avgbkg 221 WRITE(numout,*) ' Logical switch for writing out balancing increments ln_balwri = ', ln_balwri 210 222 WRITE(numout,*) ' Logical switch for applying tracer increments ln_trainc = ', ln_trainc 211 223 WRITE(numout,*) ' Logical switch for applying velocity increments ln_dyninc = ', ln_dyninc … … 213 225 WRITE(numout,*) ' Logical switch for Direct Initialization (DI) ln_asmdin = ', ln_asmdin 214 226 WRITE(numout,*) ' Logical switch for applying sea ice increments ln_seaiceinc = ', ln_seaiceinc 227 WRITE(numout,*) ' Logical switch for phytoplankton balancing ln_phytobal = ', ln_phytobal 228 WRITE(numout,*) ' Logical switch for applying slchltot increments ln_slchltotinc = ', ln_slchltotinc 229 WRITE(numout,*) ' Logical switch for applying slchldia increments ln_slchldiainc = ', ln_slchldiainc 230 WRITE(numout,*) ' Logical switch for applying slchlnon increments ln_slchlnoninc = ', ln_slchlnoninc 231 WRITE(numout,*) ' Logical switch for applying slchlnan increments ln_slchlnaninc = ', ln_slchlnaninc 232 WRITE(numout,*) ' Logical switch for applying slchlpic increments ln_slchlpicinc = ', ln_slchlpicinc 233 WRITE(numout,*) ' Logical switch for applying slchldin increments ln_slchldininc = ', ln_slchldininc 234 WRITE(numout,*) ' Logical switch for applying schltot increments ln_schltotinc = ', ln_schltotinc 235 WRITE(numout,*) ' Logical switch for applying slphytot increments ln_slphytotinc = ', ln_slphytotinc 236 WRITE(numout,*) ' Logical switch for applying slphydia increments ln_slphydiainc = ', ln_slphydiainc 237 WRITE(numout,*) ' Logical switch for applying slphynon increments ln_slphynoninc = ', ln_slphynoninc 238 WRITE(numout,*) ' Logical switch for applying spco2 increments ln_spco2inc = ', ln_spco2inc 239 WRITE(numout,*) ' Logical switch for applying sfco2 increments ln_sfco2inc = ', ln_sfco2inc 240 WRITE(numout,*) ' Logical switch for applying plchltot increments ln_plchltotinc = ', ln_plchltotinc 241 WRITE(numout,*) ' Logical switch for applying pchltot increments ln_pchltotinc = ', ln_pchltotinc 242 WRITE(numout,*) ' Logical switch for applying pno3 increments ln_pno3inc = ', ln_pno3inc 243 WRITE(numout,*) ' Logical switch for applying psi4 increments ln_psi4inc = ', ln_psi4inc 244 WRITE(numout,*) ' Logical switch for applying ppo4 increments ln_ppo4inc = ', ln_ppo4inc 245 WRITE(numout,*) ' Logical switch for applying pdic increments ln_pdicinc = ', ln_pdicinc 246 WRITE(numout,*) ' Logical switch for applying palk increments ln_palkinc = ', ln_palkinc 247 WRITE(numout,*) ' Logical switch for applying pph increments ln_pphinc = ', ln_pphinc 248 WRITE(numout,*) ' Logical switch for applying po2 increments ln_po2inc = ', ln_po2inc 215 249 WRITE(numout,*) ' Logical switch for Incremental Analysis Updating (IAU) ln_asmiau = ', ln_asmiau 216 250 WRITE(numout,*) ' Timestep of background in [0,nitend-nit000-1] nitbkg = ', nitbkg … … 223 257 WRITE(numout,*) ' Minimum salinity after applying the increments salfixmin = ', salfixmin 224 258 WRITE(numout,*) ' Choice of MLD for physics assimilation mld_choice = ', mld_choice 259 WRITE(numout,*) ' Choice of MLD for BGC assimilation mld_choice_bgc = ', mld_choice_bgc 260 WRITE(numout,*) ' Maximum absolute chlorophyll increment (<=0 = off) rn_maxchlinc = ', rn_maxchlinc 225 261 ENDIF 226 262 … … 263 299 WRITE(numout,*) ' iitavgbkg_date = ', iitavgbkg_date 264 300 ENDIF 301 IF ( ln_slchltotinc .OR. ln_slchldiainc .OR. ln_slchlnoninc .OR. & 302 & ln_slchlnaninc .OR. ln_slchlpicinc .OR. ln_slchldininc .OR. & 303 & ln_schltotinc .OR. ln_slphytotinc .OR. ln_slphydiainc .OR. & 304 & ln_slphynoninc .OR. ln_spco2inc .OR. ln_sfco2inc .OR. & 305 & ln_plchltotinc .OR. ln_pchltotinc .OR. ln_pno3inc .OR. & 306 & ln_psi4inc .OR. ln_pdicinc .OR. ln_palkinc .OR. & 307 & ln_pphinc .OR. ln_po2inc .OR. ln_ppo4inc ) THEN 308 lk_bgcinc = .TRUE. 309 ENDIF 265 310 266 311 IF ( nacc /= 0 ) & … … 274 319 275 320 IF ( ( ( .NOT. ln_asmdin ).AND.( .NOT. ln_asmiau ) ) & 276 .AND.( ( ln_trainc ).OR.( ln_dyninc ).OR.( ln_sshinc ) .OR. ( ln_seaiceinc) )) & 277 & CALL ctl_stop( ' One or more of ln_trainc, ln_dyninc, ln_sshinc and ln_seaiceinc is set to .true.', & 321 & .AND.( ( ln_trainc ).OR.( ln_dyninc ).OR.( ln_sshinc ).OR.( ln_seaiceinc ).OR. & 322 & ( lk_bgcinc ) )) & 323 & CALL ctl_stop( ' One or more of ln_trainc, ln_dyninc, ln_sshinc, ln_seaiceinc,', & 324 & ' ln_(bgc-variable)inc is set to .true.', & 278 325 & ' but ln_asmdin and ln_asmiau are both set to .false. :', & 279 326 & ' Inconsistent options') … … 284 331 285 332 IF ( ( .NOT. ln_trainc ).AND.( .NOT. ln_dyninc ).AND.( .NOT. ln_sshinc ).AND.( .NOT. ln_seaiceinc ) & 286 & ) & 287 & CALL ctl_warn( ' ln_trainc, ln_dyninc, ln_sshinc and ln_seaiceinc are set to .false. :', & 333 & .AND.( .NOT. lk_bgcinc ) ) & 334 & CALL ctl_warn( ' ln_trainc, ln_dyninc, ln_sshinc, ln_seaiceinc,', & 335 & ' ln_(bgc-variable)inc are set to .false. :', & 288 336 & ' The assimilation increments are not applied') 289 337 … … 310 358 & ' Assim bkg averaging period is outside', & 311 359 & ' the cycle interval') 360 361 IF ( lk_bgcinc ) CALL asm_bgc_check_options 312 362 313 363 IF ( nstop > 0 ) RETURN ! if there are any errors then go no further … … 412 462 ssh_iau(:,:) = 0.0 413 463 #endif 414 IF ( ( ln_trainc ).OR.( ln_dyninc ).OR.( ln_sshinc ).OR.( ln_seaiceinc ) ) THEN 464 IF ( ( ln_trainc ).OR.( ln_dyninc ).OR.( ln_sshinc ).OR.( ln_seaiceinc ) & 465 & .OR.( lk_bgcinc ) ) THEN 415 466 416 467 !-------------------------------------------------------------------- … … 545 596 ENDIF 546 597 598 IF ( lk_bgcinc ) THEN 599 CALL asm_bgc_init_incs( inum ) 600 ENDIF 601 547 602 CALL iom_close( inum ) 548 603 … … 655 710 CALL iom_close( inum ) 656 711 712 ENDIF 713 714 IF ( lk_bgcinc ) THEN 715 CALL asm_bgc_init_bkg 657 716 ENDIF 658 717 ! … … 1276 1335 1277 1336 END SUBROUTINE seaice_asm_inc 1337 1338 1339 SUBROUTINE bgc_asm_inc( kt ) 1340 !!---------------------------------------------------------------------- 1341 !! *** ROUTINE bgc_asm_inc *** 1342 !! 1343 !! ** Purpose : Apply the biogeochemistry assimilation increments 1344 !! 1345 !! ** Method : Call relevant routines in asmbgc 1346 !! 1347 !! ** Action : Call relevant routines in asmbgc 1348 !! 1349 !!---------------------------------------------------------------------- 1350 !! 1351 INTEGER, INTENT(in ) :: kt ! Current time step 1352 ! 1353 INTEGER :: icycper ! Dimension of wgtiau 1354 !! 1355 !!---------------------------------------------------------------------- 1356 1357 icycper = SIZE( wgtiau ) 1358 1359 ! Ocean colour variables first 1360 IF ( ln_slchltotinc .OR. ln_slchldiainc .OR. ln_slchlnoninc .OR. & 1361 & ln_slchlnaninc .OR. ln_slchlpicinc .OR. ln_slchldininc .OR. & 1362 & ln_schltotinc .OR. ln_slphytotinc .OR. ln_slphydiainc .OR. & 1363 & ln_slphynoninc ) THEN 1364 CALL phyto2d_asm_inc( kt, ln_asmdin, ln_asmiau, icycper, wgtiau ) 1365 ENDIF 1366 1367 ! Surface pCO2/fCO2 next 1368 IF ( ln_sfco2inc .OR. ln_spco2inc ) THEN 1369 CALL pco2_asm_inc( kt, ln_asmdin, ln_asmiau, icycper, wgtiau, & 1370 & ln_trainc, t_bkginc, s_bkginc ) 1371 ENDIF 1372 1373 ! Profile pH next 1374 IF ( ln_pphinc ) THEN 1375 CALL ph_asm_inc( kt, ln_asmdin, ln_asmiau, icycper, wgtiau, & 1376 & ln_trainc, t_bkginc, s_bkginc ) 1377 ENDIF 1378 1379 ! Then chlorophyll profiles 1380 IF ( ln_plchltotinc .OR. ln_pchltotinc ) THEN 1381 CALL phyto3d_asm_inc( kt, ln_asmdin, ln_asmiau, icycper, wgtiau ) 1382 ENDIF 1383 1384 ! Remaining bgc profile variables 1385 IF ( ln_pno3inc .OR. ln_psi4inc .OR. ln_pdicinc .OR. & 1386 & ln_palkinc .OR. ln_po2inc .OR. ln_ppo4inc ) THEN 1387 CALL bgc3d_asm_inc( kt, ln_asmdin, ln_asmiau, icycper, wgtiau ) 1388 ENDIF 1389 1390 END SUBROUTINE bgc_asm_inc 1278 1391 1279 1392 !!====================================================================== -
branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/OPA_SRC/ASM/asmpar.F90
r9180 r10850 20 20 & c_asmtrj = 'assim_trj', & !: Filename for storing the 21 21 !: reference trajectory 22 & c_asminc = 'assim_background_increments' 22 & c_asminc = 'assim_background_increments', & !: Filename for storing the 23 23 !: increments to the background 24 24 !: state 25 & c_asmbal = 'assim.balincs' !: Filename for storing the 26 !: balancing increments calculated 27 !: for biogeochemistry 25 28 26 29 INTEGER, PUBLIC :: nitbkg_r !: Background time step referenced to nit000 -
branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90
r8561 r10850 21 21 #endif 22 22 USE diatmb 23 #if defined key_fabm 24 USE trc, ONLY: trn 25 USE par_fabm 26 USE st2d_fabm, ONLY: fabm_st2dn 27 USE fabm, ONLY: fabm_get_interior_diagnostic_data, & 28 & fabm_get_horizontal_diagnostic_data 29 #endif 23 30 24 31 IMPLICIT NONE … … 39 46 #if defined key_zdfgls 40 47 REAL(wp),SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: rmxln_25h 48 #endif 49 #if defined key_fabm 50 REAL(wp),SAVE, ALLOCATABLE, DIMENSION(:,:,:,:) :: fabm_25h 51 REAL(wp),SAVE, ALLOCATABLE, DIMENSION(:,:,:,:) :: fabm_3d_25h 52 REAL(wp),SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: fabm_surface_25h 53 REAL(wp),SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: fabm_bottom_25h 54 REAL(wp),SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: fabm_2d_25h 41 55 #endif 42 56 INTEGER, SAVE :: cnt_25h ! Counter for 25 hour means … … 64 78 INTEGER :: ios ! Local integer output status for namelist read 65 79 INTEGER :: ierror ! Local integer for memory allocation 80 INTEGER :: jn ! Loop counter 66 81 REAL(wp), DIMENSION(jpi,jpj,3) :: zwtmb ! temporary workspace 67 82 ! … … 145 160 CALL ctl_stop( 'dia_25h: unable to allocate sshn_25h' ) ; RETURN 146 161 ENDIF 162 #if defined key_fabm 163 ALLOCATE( fabm_25h(jpi,jpj,jpk,jp_fabm), STAT=ierror ) 164 IF( ierror > 0 ) THEN 165 CALL ctl_stop( 'dia_25h: unable to allocate fabm_25h' ) ; RETURN 166 ENDIF 167 ALLOCATE( fabm_3d_25h(jpi,jpj,jpk,jp_fabm_3d), STAT=ierror ) 168 IF( ierror > 0 ) THEN 169 CALL ctl_stop( 'dia_25h: unable to allocate fabm_3d_25h' ) ; RETURN 170 ENDIF 171 ALLOCATE( fabm_surface_25h(jpi,jpj,jp_fabm_surface), STAT=ierror ) 172 IF( ierror > 0 ) THEN 173 CALL ctl_stop( 'dia_25h: unable to allocate fabm_surface_25h' ) ; RETURN 174 ENDIF 175 ALLOCATE( fabm_bottom_25h(jpi,jpj,jp_fabm_bottom), STAT=ierror ) 176 IF( ierror > 0 ) THEN 177 CALL ctl_stop( 'dia_25h: unable to allocate fabm_bottom_25h' ) ; RETURN 178 ENDIF 179 ALLOCATE( fabm_2d_25h(jpi,jpj,jp_fabm_2d), STAT=ierror ) 180 IF( ierror > 0 ) THEN 181 CALL ctl_stop( 'dia_25h: unable to allocate fabm_2d_25h' ) ; RETURN 182 ENDIF 183 #endif 147 184 ! ------------------------- ! 148 185 ! 2 - Assign Initial Values ! … … 169 206 rmxln_25h(:,:,:) = mxln(:,:,:) 170 207 #endif 208 #if defined key_fabm 209 DO jn = 1, jp_fabm 210 fabm_25h(:,:,:,jn) = trn(:,:,:,jp_fabm_m1+jn) 211 END DO 212 DO jn = 1, jp_fabm_3d 213 fabm_3d_25h(:,:,:,jn) = fabm_get_interior_diagnostic_data(model, jn) 214 END DO 215 DO jn = 1, jp_fabm_surface 216 fabm_surface_25h(:,:,jn) = fabm_st2dn(:,:,jn) 217 END DO 218 DO jn = 1, jp_fabm_bottom 219 fabm_bottom_25h(:,:,jn) = fabm_st2dn(:,:,jp_fabm_surface+jn) 220 END DO 221 DO jn = 1, jp_fabm_2d 222 fabm_2d_25h(:,:,jn) = fabm_get_horizontal_diagnostic_data(model,jn) 223 END DO 224 #endif 171 225 #if defined key_lim3 || defined key_lim2 172 226 CALL ctl_stop('STOP', 'dia_25h not setup yet to do tidemean ice') … … 207 261 208 262 !! * Local declarations 209 INTEGER :: ji, jj, jk 263 INTEGER :: ji, jj, jk, jn 210 264 211 265 LOGICAL :: ll_print = .FALSE. ! =T print and flush numout … … 268 322 rmxln_25h(:,:,:) = rmxln_25h(:,:,:) + mxln(:,:,:) 269 323 #endif 324 #if defined key_fabm 325 DO jn = 1, jp_fabm 326 fabm_25h(:,:,:,jn) = fabm_25h(:,:,:,jn) + trn(:,:,:,jp_fabm_m1+jn) 327 END DO 328 DO jn = 1, jp_fabm_3d 329 fabm_3d_25h(:,:,:,jn) = fabm_3d_25h(:,:,:,jn) + fabm_get_interior_diagnostic_data(model, jn) 330 END DO 331 DO jn = 1, jp_fabm_surface 332 fabm_surface_25h(:,:,jn) = fabm_surface_25h(:,:,jn) + fabm_st2dn(:,:,jn) 333 END DO 334 DO jn = 1, jp_fabm_bottom 335 fabm_bottom_25h(:,:,jn) = fabm_bottom_25h(:,:,jn) + fabm_st2dn(:,:,jp_fabm_surface+jn) 336 END DO 337 DO jn = 1, jp_fabm_2d 338 fabm_2d_25h(:,:,jn) = fabm_2d_25h(:,:,jn) + fabm_get_horizontal_diagnostic_data(model,jn) 339 END DO 340 #endif 270 341 cnt_25h = cnt_25h + 1 271 342 … … 300 371 # if defined key_zdfgls 301 372 rmxln_25h(:,:,:) = rmxln_25h(:,:,:) / 25.0_wp 373 #endif 374 #if defined key_fabm 375 fabm_25h(:,:,:,:) = fabm_25h(:,:,:,:) / 25.0_wp 376 fabm_3d_25h(:,:,:,:) = fabm_3d_25h(:,:,:,:) / 25.0_wp 377 fabm_surface_25h(:,:,:) = fabm_surface_25h(:,:,:) / 25.0_wp 378 fabm_bottom_25h(:,:,:) = fabm_bottom_25h(:,:,:) / 25.0_wp 379 fabm_2d_25h(:,:,:) = fabm_2d_25h(:,:,:) / 25.0_wp 302 380 #endif 303 381 … … 319 397 CALL iom_put( "ssh25h", zw2d ) ! sea surface 320 398 399 #if defined key_fabm 400 ! Write ERSEM variables 401 DO jn = 1, jp_fabm 402 zw3d(:,:,:) = fabm_25h(:,:,:,jn)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 403 CALL iom_put( TRIM(model%state_variables(jn)%name)//"25h", zw3d ) 404 END DO 405 DO jn = 1, jp_fabm_3d 406 zw3d(:,:,:) = fabm_3d_25h(:,:,:,jn)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) 407 CALL iom_put( TRIM(model%diagnostic_variables(jn)%name)//"25h", zw3d ) 408 END DO 409 DO jn = 1, jp_fabm_surface 410 zw2d(:,:) = fabm_surface_25h(:,:,jn)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1)) 411 CALL iom_put( TRIM(model%surface_state_variables(jn)%name)//"25h", zw2d ) 412 END DO 413 DO jn = 1, jp_fabm_bottom 414 zw2d(:,:) = fabm_bottom_25h(:,:,jn)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1)) 415 CALL iom_put( TRIM(model%bottom_state_variables(jn)%name)//"25h", zw2d ) 416 END DO 417 DO jn = 1, jp_fabm_2d 418 zw2d(:,:) = fabm_2d_25h(:,:,jn)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1)) 419 CALL iom_put( TRIM(model%horizontal_diagnostic_variables(jn)%name)//"25h", zw2d ) 420 END DO 421 #endif 321 422 322 423 ! Write velocities (instantaneous) … … 362 463 rmxln_25h(:,:,:) = mxln(:,:,:) 363 464 #endif 465 #if defined key_fabm 466 DO jn = 1, jp_fabm 467 fabm_25h(:,:,:,jn) = trn(:,:,:,jp_fabm_m1+jn) 468 END DO 469 DO jn = 1, jp_fabm_3d 470 fabm_3d_25h(:,:,:,jn) = fabm_get_interior_diagnostic_data(model, jn) 471 END DO 472 DO jn = 1, jp_fabm_surface 473 fabm_surface_25h(:,:,jn) = fabm_st2dn(:,:,jn) 474 END DO 475 DO jn = 1, jp_fabm_bottom 476 fabm_bottom_25h(:,:,jn) = fabm_st2dn(:,:,jp_fabm_surface+jn) 477 END DO 478 DO jn = 1, jp_fabm_2d 479 fabm_2d_25h(:,:,jn) = fabm_get_horizontal_diagnostic_data(model,jn) 480 END DO 481 #endif 364 482 cnt_25h = 1 365 483 IF (lwp) WRITE(numout,*) 'dia_wri_tide : After 25hr mean write, reset sum to current value and cnt_25h to one for overlapping average',cnt_25h -
branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/OPA_SRC/DIA/diaopfoam.F90
r8561 r10850 109 109 CALL iom_put( "voce_op" , vn ) ! j-current 110 110 !CALL iom_put( "woce_op" , wn ) ! k-current 111 #if defined key_spm112 cltra = TRIM(ctrc3d(5))//"_op"113 zw3d(:,:,:) = trc3d(:,:,:,5)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:)) ! Visibility114 CALL iom_put( cltra, zw3d )115 #endif116 111 CALL calc_max_cur(zwu,zwv,zwz,zmdi) 117 112 CALL iom_put( "maxu" , zwu ) ! max u current -
branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/OPA_SRC/DIA/diatmb.F90
r8561 r10850 11 11 USE iom ! I/0 library 12 12 USE wrk_nemo ! working arrays 13 #if defined key_fabm 14 USE trc, ONLY: trn 15 USE par_fabm 16 USE fabm, ONLY: fabm_get_interior_diagnostic_data 17 #endif 13 18 14 19 … … 133 138 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwtmb ! temporary workspace 134 139 REAL(wp) :: zmdi ! set masked values 140 INTEGER :: jn ! loop counter 135 141 136 142 zmdi=1.e+20 !missing data indicator for maskin … … 162 168 CALL iom_put( "bot_v" , zwtmb(:,:,3) ) ! tmb V Velocity 163 169 !Called in dynspg_ts.F90 CALL iom_put( "baro_v" , vn_b ) ! Barotropic V Velocity 170 171 #if defined key_fabm 172 DO jn = 1, jp_fabm 173 CALL dia_calctmb( trn(:,:,:,jp_fabm_m1+jn), zwtmb ) 174 CALL iom_put( "top_"//TRIM(model%state_variables(jn)%name) , zwtmb(:,:,1) ) 175 CALL iom_put( "mid_"//TRIM(model%state_variables(jn)%name) , zwtmb(:,:,2) ) 176 CALL iom_put( "bot_"//TRIM(model%state_variables(jn)%name) , zwtmb(:,:,3) ) 177 END DO 178 DO jn = 1, jp_fabm_3d 179 CALL dia_calctmb( fabm_get_interior_diagnostic_data(model, jn), zwtmb ) 180 CALL iom_put( "top_"//TRIM(model%diagnostic_variables(jn)%name) , zwtmb(:,:,1) ) 181 CALL iom_put( "mid_"//TRIM(model%diagnostic_variables(jn)%name) , zwtmb(:,:,2) ) 182 CALL iom_put( "bot_"//TRIM(model%diagnostic_variables(jn)%name) , zwtmb(:,:,3) ) 183 END DO 184 #endif 164 185 ELSE 165 186 CALL ctl_warn('dia_tmb: tmb diagnostic is set to false you should not have seen this') -
branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90
r8058 r10850 38 38 LOGICAL, PUBLIC, PARAMETER :: lk_zdftmx = .TRUE. !: tidal mixing flag 39 39 40 ! !!* Namelist namzdf_tmx : tidal mixing *41 REAL(wp) :: rn_htmx ! vertical decay scale for turbulence (meters)42 REAL(wp) :: rn_n2min ! threshold of the Brunt-Vaisala frequency (s-1)43 REAL(wp) :: rn_tfe ! tidal dissipation efficiency (St Laurent et al. 2002)44 REAL(wp) :: rn_me ! mixing efficiency (Osborn 1980)45 LOGICAL 46 REAL(wp) :: rn_tfe_itf ! ITF tidal dissipation efficiency (St Laurent et al. 2002)47 48 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: en_tmx ! energy available for tidal mixing (W/m2)49 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) 50 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: az_tmx ! coefficient used to evaluate the tidal induced Kz40 ! !!* Namelist namzdf_tmx : tidal mixing * 41 REAL(wp) :: rn_htmx ! vertical decay scale for turbulence (meters) 42 REAL(wp) :: rn_n2min ! threshold of the Brunt-Vaisala frequency (s-1) 43 REAL(wp) :: rn_tfe ! tidal dissipation efficiency (St Laurent et al. 2002) 44 REAL(wp) :: rn_me ! mixing efficiency (Osborn 1980) 45 LOGICAL, PUBLIC :: ln_tmx_itf ! Indonesian Through Flow (ITF): Koch-Larrouy et al. (2007) parameterization 46 REAL(wp) :: rn_tfe_itf ! ITF tidal dissipation efficiency (St Laurent et al. 2002) 47 48 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: en_tmx ! energy available for tidal mixing (W/m2) 49 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: mask_itf ! mask to use over Indonesian area 50 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: az_tmx ! coefficient used to evaluate the tidal induced Kz 51 51 52 52 !! * Substitutions -
branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r10394 r10850 61 61 USE asminc ! assimilation increments 62 62 USE asmbkg ! writing out state trajectory 63 USE asmbgc ! biogeochemical assimilation increments 63 64 USE diaptr ! poleward transports (dia_ptr_init routine) 64 65 USE diadct ! sections transports (dia_dct_init routine) … … 163 164 IF( ln_dyninc ) CALL dyn_asm_inc( nit000 - 1 ) ! Dynamics 164 165 IF( ln_sshinc ) CALL ssh_asm_inc( nit000 - 1 ) ! SSH 166 IF( lk_bgcinc ) CALL bgc_asm_inc( nit000 - 1 ) ! BGC 165 167 ENDIF 166 168 ENDIF … … 194 196 195 197 IF( lk_diaobs ) CALL dia_obs_wri 198 ! 199 IF( ( lk_asminc ).AND.( ln_balwri ) ) CALL asm_bgc_bal_wri( nitend ) ! Output balancing increments 196 200 ! 197 201 IF( ln_icebergs ) CALL icb_end( nitend ) -
branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/OPA_SRC/step.F90
r10478 r10850 277 277 ! Passive Tracer Model 278 278 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 279 IF( lk_asminc .AND. ln_asmiau .AND. lk_bgcinc ) & 280 & CALL bgc_asm_inc( kstp ) ! biogeochemistry assimilation 279 281 CALL trc_stp( kstp ) ! time-stepping 280 282 #endif -
branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/TOP_SRC/FABM/par_fabm.F90
r10156 r10850 9 9 INTEGER, PUBLIC :: jp_fabm0, jp_fabm1, jp_fabm, & 10 10 jp_fabm_surface, jp_fabm_bottom, & 11 jp_fabm_m1 11 jp_fabm_m1, jp_fabm_2d, jp_fabm_3d 12 13 ! Variables needed for OBS/ASM 14 INTEGER, PUBLIC :: jp_fabm_chl1, jp_fabm_chl2, & 15 jp_fabm_chl3, jp_fabm_chl4, & 16 jp_fabm_p1c, jp_fabm_p1n, & 17 jp_fabm_p1p, jp_fabm_p1s, & 18 jp_fabm_p2c, jp_fabm_p2n, & 19 jp_fabm_p2p, jp_fabm_p3c, & 20 jp_fabm_p3n, jp_fabm_p3p, & 21 jp_fabm_p4c, jp_fabm_p4n, & 22 jp_fabm_p4p, jp_fabm_z4c, & 23 jp_fabm_z5c, jp_fabm_z5n, & 24 jp_fabm_z5p, jp_fabm_z6c, & 25 jp_fabm_z6n, jp_fabm_z6p, & 26 jp_fabm_n1p, jp_fabm_n3n, & 27 jp_fabm_n4n, jp_fabm_n5s, & 28 jp_fabm_o2o, jp_fabm_o3c, & 29 jp_fabm_o3ta, jp_fabm_o3ba, & 30 jp_fabm_o3pc, jp_fabm_o3ph, & 31 jp_fabm_r4n, jp_fabm_r4c, & 32 jp_fabm_r4p, jp_fabm_r6n, & 33 jp_fabm_r6c, jp_fabm_r6p, & 34 jp_fabm_r6s, jp_fabm_r8n, & 35 jp_fabm_r8c, jp_fabm_r8p, & 36 jp_fabm_r8s, & 37 jp_fabm_pgrow, jp_fabm_ploss 12 38 13 39 #if defined key_fabm -
branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/TOP_SRC/FABM/trcini_fabm.F90
r10158 r10850 65 65 jp_fabm_m1=jptra 66 66 jptra = jptra + jp_fabm 67 jpdia2d = jpdia2d + size(model%horizontal_diagnostic_variables) 68 jpdia3d = jpdia3d + size(model%diagnostic_variables) 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 69 71 jpdiabio = jpdiabio + jp_fabm 70 72 71 73 !Initialize input data structures. 72 74 call initialize_inputs 75 76 ! Get indexes for select state variables 77 jp_fabm_chl1 = fabm_state_index( 'P1_Chl' ) 78 jp_fabm_chl2 = fabm_state_index( 'P2_Chl' ) 79 jp_fabm_chl3 = fabm_state_index( 'P3_Chl' ) 80 jp_fabm_chl4 = fabm_state_index( 'P4_Chl' ) 81 jp_fabm_p1c = fabm_state_index( 'P1_c' ) 82 jp_fabm_p1n = fabm_state_index( 'P1_n' ) 83 jp_fabm_p1p = fabm_state_index( 'P1_p' ) 84 jp_fabm_p1s = fabm_state_index( 'P1_s' ) 85 jp_fabm_p2c = fabm_state_index( 'P2_c' ) 86 jp_fabm_p2n = fabm_state_index( 'P2_n' ) 87 jp_fabm_p2p = fabm_state_index( 'P2_p' ) 88 jp_fabm_p3c = fabm_state_index( 'P3_c' ) 89 jp_fabm_p3n = fabm_state_index( 'P3_n' ) 90 jp_fabm_p3p = fabm_state_index( 'P3_p' ) 91 jp_fabm_p4c = fabm_state_index( 'P4_c' ) 92 jp_fabm_p4n = fabm_state_index( 'P4_n' ) 93 jp_fabm_p4p = fabm_state_index( 'P4_p' ) 94 jp_fabm_z4c = fabm_state_index( 'Z4_c' ) 95 jp_fabm_z5c = fabm_state_index( 'Z5_c' ) 96 jp_fabm_z5n = fabm_state_index( 'Z5_n' ) 97 jp_fabm_z5p = fabm_state_index( 'Z5_p' ) 98 jp_fabm_z6c = fabm_state_index( 'Z6_c' ) 99 jp_fabm_z6n = fabm_state_index( 'Z6_n' ) 100 jp_fabm_z6p = fabm_state_index( 'Z6_p' ) 101 jp_fabm_n1p = fabm_state_index( 'N1_p' ) 102 jp_fabm_n3n = fabm_state_index( 'N3_n' ) 103 jp_fabm_n4n = fabm_state_index( 'N4_n' ) 104 jp_fabm_n5s = fabm_state_index( 'N5_s' ) 105 jp_fabm_o2o = fabm_state_index( 'O2_o' ) 106 jp_fabm_o3c = fabm_state_index( 'O3_c' ) 107 jp_fabm_o3ba = fabm_state_index( 'O3_bioalk' ) 108 jp_fabm_r4n = fabm_state_index( 'R4_n' ) 109 jp_fabm_r4c = fabm_state_index( 'R4_c' ) 110 jp_fabm_r4p = fabm_state_index( 'R4_p' ) 111 jp_fabm_r6n = fabm_state_index( 'R6_n' ) 112 jp_fabm_r6c = fabm_state_index( 'R6_c' ) 113 jp_fabm_r6p = fabm_state_index( 'R6_p' ) 114 jp_fabm_r6s = fabm_state_index( 'R6_s' ) 115 jp_fabm_r8n = fabm_state_index( 'R8_n' ) 116 jp_fabm_r8c = fabm_state_index( 'R8_c' ) 117 jp_fabm_r8p = fabm_state_index( 'R8_p' ) 118 jp_fabm_r8s = fabm_state_index( 'R8_s' ) 119 120 ! Get indexes for select diagnostic variables 121 jp_fabm_o3ta = fabm_diag_index( 'O3_TA' ) 122 jp_fabm_o3ph = fabm_diag_index( 'O3_pH' ) 123 jp_fabm_o3pc = fabm_diag_index( 'O3_pCO2' ) 124 jp_fabm_pgrow = fabm_diag_index( 'p_grow_sum_result' ) 125 jp_fabm_ploss = fabm_diag_index( 'p_loss_sum_result' ) 126 127 MLD_MAX(:,:) = 0.0 128 PGROW_AVG(:,:) = 0.0 129 PLOSS_AVG(:,:) = 0.0 130 PHYT_AVG(:,:) = 0.0 73 131 74 132 IF (lwp) THEN … … 84 142 CALL write_trends_xml(xml_unit,model%state_variables(jn)) 85 143 #endif 144 CALL write_25hourm_xml(xml_unit,model%state_variables(jn)) 145 CALL write_tmb_xml(xml_unit,model%state_variables(jn)) 86 146 END DO 87 147 WRITE (xml_unit,1000) ' </field_group>' … … 90 150 DO jn=1,jp_fabm_surface 91 151 CALL write_variable_xml(xml_unit,model%surface_state_variables(jn)) 152 CALL write_25hourm_xml(xml_unit,model%surface_state_variables(jn)) 92 153 END DO 93 154 DO jn=1,jp_fabm_bottom 94 155 CALL write_variable_xml(xml_unit,model%bottom_state_variables(jn)) 156 CALL write_25hourm_xml(xml_unit,model%bottom_state_variables(jn)) 95 157 END DO 96 158 WRITE (xml_unit,1000) ' </field_group>' … … 99 161 DO jn=1,size(model%diagnostic_variables) 100 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)) 101 165 END DO 102 166 DO jn=1,size(model%horizontal_diagnostic_variables) 103 167 CALL write_variable_xml(xml_unit,model%horizontal_diagnostic_variables(jn)) 168 CALL write_25hourm_xml(xml_unit,model%horizontal_diagnostic_variables(jn)) 104 169 END DO 105 170 WRITE (xml_unit,1000) ' </field_group>' … … 168 233 169 234 END SUBROUTINE write_variable_xml 235 236 SUBROUTINE write_25hourm_xml(xml_unit,variable,flag_grid_ref) 237 INTEGER,INTENT(IN) :: xml_unit 238 INTEGER,INTENT(IN),OPTIONAL :: flag_grid_ref 239 CLASS (type_external_variable),INTENT(IN) :: variable 240 241 CHARACTER(LEN=20) :: missing_value,string_dimensions 242 INTEGER :: number_dimensions 243 244 ! Check variable dimension for grid_ref specificaiton. 245 ! Default is to not specify the grid_ref in the field definition. 246 IF (present(flag_grid_ref)) THEN 247 number_dimensions=flag_grid_ref 248 ELSE 249 number_dimensions=-1 !default, don't specify grid_ref 250 ENDIF 251 252 WRITE (missing_value,'(E9.3)') 1.e+20 253 WRITE (string_dimensions,'(I1)') number_dimensions 254 SELECT CASE (number_dimensions) 255 CASE (3) 256 WRITE (xml_unit,'(A)') ' <field id="'//TRIM(variable%name)//'25h'//'" long_name="'//TRIM(variable%long_name)//' 25-hour mean'//'" unit="'//TRIM(variable%units)//'" default_value="'//TRIM(ADJUSTL(missing_value))//'" grid_ref="grid_T_3D" />' 257 CASE (2) 258 WRITE (xml_unit,'(A)') ' <field id="'//TRIM(variable%name)//'25h'//'" long_name="'//TRIM(variable%long_name)//' 25-hour mean'//'" unit="'//TRIM(variable%units)//'" default_value="'//TRIM(ADJUSTL(missing_value))//'" grid_ref="grid_T_2D"/>' 259 CASE (0) 260 WRITE (xml_unit,'(A)') ' <field id="'//TRIM(variable%name)//'25h'//'" long_name="'//TRIM(variable%long_name)//' 25-hour mean'//'" unit="'//TRIM(variable%units)//'" default_value="'//TRIM(ADJUSTL(missing_value))//'" grid_ref="1point"/>' 261 CASE (-1) 262 WRITE (xml_unit,'(A)') ' <field id="'//TRIM(variable%name)//'25h'//'" long_name="'//TRIM(variable%long_name)//' 25-hour mean'//'" unit="'//TRIM(variable%units)//'" default_value="'//TRIM(ADJUSTL(missing_value))//'" />' 263 CASE default 264 IF(lwp) WRITE(numout,*) ' trc_ini_fabm: Failing to initialise output of variable '//TRIM(variable%name)//'25h'//': Output of '//TRIM(ADJUSTL(string_dimensions))//'-dimensional variables not supported!!!' 265 END SELECT 266 267 END SUBROUTINE write_25hourm_xml 268 269 SUBROUTINE write_tmb_xml(xml_unit,variable) 270 INTEGER,INTENT(IN) :: xml_unit 271 CLASS (type_external_variable),INTENT(IN) :: variable 272 273 CHARACTER(LEN=20) :: missing_value 274 275 WRITE (missing_value,'(E9.3)') 1.e+20 276 WRITE (xml_unit,'(A)') ' <field id="top_'//TRIM(variable%name)//'" long_name="Top-level '//TRIM(variable%long_name)//'" unit="'//TRIM(variable%units)//'" default_value="'//TRIM(ADJUSTL(missing_value))//'" grid_ref="grid_T_2D"/>' 277 WRITE (xml_unit,'(A)') ' <field id="mid_'//TRIM(variable%name)//'" long_name="Middle-level '//TRIM(variable%long_name)//'" unit="'//TRIM(variable%units)//'" default_value="'//TRIM(ADJUSTL(missing_value))//'" grid_ref="grid_T_2D"/>' 278 WRITE (xml_unit,'(A)') ' <field id="bot_'//TRIM(variable%name)//'" long_name="Bottom-level '//TRIM(variable%long_name)//'" unit="'//TRIM(variable%units)//'" default_value="'//TRIM(ADJUSTL(missing_value))//'" grid_ref="grid_T_2D"/>' 279 280 END SUBROUTINE write_tmb_xml 170 281 171 282 SUBROUTINE write_trends_xml(xml_unit,variable,flag_grid_ref) … … 328 439 END SUBROUTINE trc_ini_fabm 329 440 441 INTEGER FUNCTION fabm_state_index( state_name ) 442 !!---------------------------------------------------------------------- 443 !! *** fabm_state_index *** 444 !! 445 !! ** Purpose : return index of a given FABM state variable 446 !! 447 !! ** Method : - loop through state variables until found 448 !!---------------------------------------------------------------------- 449 450 IMPLICIT NONE 451 452 CHARACTER(LEN=256), INTENT(IN) :: state_name 453 454 INTEGER :: jn 455 456 !!---------------------------------------------------------------------- 457 458 fabm_state_index = -1 459 DO jn=1,jp_fabm 460 IF (TRIM(model%state_variables(jn)%name) == TRIM(state_name)) THEN 461 fabm_state_index = jn 462 EXIT 463 ENDIF 464 END DO 465 IF (fabm_state_index == -1) THEN 466 CALL ctl_warn( 'Could not find '//TRIM(state_name)//' state variable' ) 467 ELSE 468 IF (lwp) WRITE(numout,*) 'Index for '//TRIM(state_name)//' is: ', fabm_state_index 469 ENDIF 470 471 END FUNCTION fabm_state_index 472 473 INTEGER FUNCTION fabm_diag_index( diag_name ) 474 !!---------------------------------------------------------------------- 475 !! *** fabm_state_index *** 476 !! 477 !! ** Purpose : return index of a given FABM diagnostic variable 478 !! 479 !! ** Method : - loop through diagnostic variables until found 480 !!---------------------------------------------------------------------- 481 482 IMPLICIT NONE 483 484 CHARACTER(LEN=256), INTENT(IN) :: diag_name 485 486 INTEGER :: jn 487 488 !!---------------------------------------------------------------------- 489 490 fabm_diag_index = -1 491 DO jn = 1, SIZE(model%diagnostic_variables) 492 IF (TRIM(model%diagnostic_variables(jn)%name) == TRIM(diag_name)) THEN 493 fabm_diag_index = jn 494 EXIT 495 ENDIF 496 END DO 497 IF (fabm_diag_index == -1) THEN 498 CALL ctl_warn( 'Could not find '//TRIM(diag_name)//' diagnostic' ) 499 ELSE 500 IF (lwp) WRITE(numout,*) 'Index for '//TRIM(diag_name)//' is: ', fabm_diag_index 501 ENDIF 502 503 END FUNCTION fabm_diag_index 504 330 505 #else 331 506 !!---------------------------------------------------------------------- -
branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/TOP_SRC/FABM/trcsms_fabm.F90
r10156 r10850 33 33 USE inputs_fabm 34 34 USE vertical_movement_fabm 35 USE zdfmxl 36 USE asmbgc, ONLY: mld_choice_bgc 37 USE lbclnk 35 38 36 39 !USE fldread ! time interpolation … … 113 116 114 117 CALL st2d_fabm_nxt( kt ) 118 119 CALL asmdiags_fabm( kt ) 115 120 116 121 IF( l_trdtrc ) CALL wrk_alloc( jpi, jpj, jpk, ztrfabm ) … … 130 135 131 136 END SUBROUTINE trc_sms_fabm 137 138 SUBROUTINE asmdiags_fabm( kt ) 139 INTEGER, INTENT(IN) :: kt 140 INTEGER :: ji,jj,jk,jkmax 141 REAL(wp), DIMENSION(jpi,jpj,jpk) :: pgrow_3d, ploss_3d, zmld 142 143 IF (kt == nittrc000) THEN 144 MLD_MAX(:,:) = 0.0 145 ENDIF 146 PGROW_AVG(:,:) = 0.0 147 PLOSS_AVG(:,:) = 0.0 148 PHYT_AVG(:,:) = 0.0 149 150 pgrow_3d(:,:,:) = fabm_get_bulk_diagnostic_data(model, jp_fabm_pgrow) 151 ploss_3d(:,:,:) = fabm_get_bulk_diagnostic_data(model, jp_fabm_ploss) 152 153 SELECT CASE( mld_choice_bgc ) 154 CASE ( 1 ) ! Turbocline/mixing depth [W points] 155 zmld(:,:) = hmld(:,:) 156 CASE ( 2 ) ! Density criterion (0.01 kg/m^3 change from 10m) [W points] 157 zmld(:,:) = hmlp(:,:) 158 CASE ( 3 ) ! Kara MLD [Interpolated] 159 #if defined key_karaml 160 IF ( ln_kara ) THEN 161 zmld(:,:) = hmld_kara(:,:) 162 ELSE 163 CALL ctl_stop( ' Kara mixed layer requested for BGC assimilation,', & 164 & ' but ln_kara=.false.' ) 165 ENDIF 166 #else 167 CALL ctl_stop( ' Kara mixed layer requested for BGC assimilation,', & 168 & ' but is not defined' ) 169 #endif 170 CASE ( 4 ) ! Temperature criterion (0.2 K change from surface) [T points] 171 zmld(:,:) = hmld_tref(:,:) 172 CASE ( 5 ) ! Density criterion (0.01 kg/m^3 change from 10m) [T points] 173 zmld(:,:) = hmlpt(:,:) 174 END SELECT 175 176 DO jj = 2, jpjm1 177 DO ji = 2, jpim1 178 ! 179 jkmax = jpk-1 180 DO jk = jpk-1, 1, -1 181 IF ( ( zmld(ji,jj) > gdepw_n(ji,jj,jk) ) .AND. & 182 & ( zmld(ji,jj) <= gdepw_n(ji,jj,jk+1) ) ) THEN 183 zmld(ji,jj) = gdepw_n(ji,jj,jk+1) 184 jkmax = jk 185 ENDIF 186 END DO 187 ! 188 DO jk = 1, jkmax 189 PHYT_AVG(ji,jj) = PHYT_AVG(ji,jj) + & 190 & trn(ji,jj,jk,jp_fabm_m1+jp_fabm_p1n) + & 191 & trn(ji,jj,jk,jp_fabm_m1+jp_fabm_p2n) + & 192 & trn(ji,jj,jk,jp_fabm_m1+jp_fabm_p3n) + & 193 & trn(ji,jj,jk,jp_fabm_m1+jp_fabm_p4n) 194 IF ( pgrow_3d(ji,jj,jk) .GT. 0.0 ) THEN 195 PGROW_AVG(ji,jj) = PGROW_AVG(ji,jj) + & 196 & pgrow_3d(ji,jj,jk) 197 ENDIF 198 IF ( ploss_3d(ji,jj,jk) .GT. 0.0 ) THEN 199 PLOSS_AVG(ji,jj) = PLOSS_AVG(ji,jj) + & 200 & ploss_3d(ji,jj,jk) 201 ENDIF 202 END DO 203 204 PHYT_AVG(ji,jj) = PHYT_AVG(ji,jj) / REAL(jkmax) 205 PGROW_AVG(ji,jj) = PGROW_AVG(ji,jj) / REAL(jkmax) 206 PLOSS_AVG(ji,jj) = PLOSS_AVG(ji,jj) / REAL(jkmax) 207 208 IF ( zmld(ji,jj) .GT. MLD_MAX(ji,jj) ) THEN 209 MLD_MAX(ji,jj) = zmld(ji,jj) 210 ENDIF 211 ! 212 END DO 213 END DO 214 215 PHYT_AVG(:,:) = PHYT_AVG(:,:) * tmask(:,:,1) 216 PGROW_AVG(:,:) = PGROW_AVG(:,:) * tmask(:,:,1) 217 PLOSS_AVG(:,:) = PLOSS_AVG(:,:) * tmask(:,:,1) 218 MLD_MAX(:,:) = MLD_MAX(:,:) * tmask(:,:,1) 219 220 END SUBROUTINE asmdiags_fabm 132 221 133 222 SUBROUTINE compute_fabm() -
branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/TOP_SRC/trc.F90
r10162 r10850 225 225 #endif 226 226 227 #if defined key_fabm 228 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: PGROW_AVG !: Phytoplankton growth for use in ASM code 229 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: PLOSS_AVG !: Phytoplankton loss for use in ASM code 230 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: PHYT_AVG !: Phytoplankton for use in ASM code 231 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: MLD_MAX !: Maximum MLD for use in ASM code 232 #endif 233 227 234 !!---------------------------------------------------------------------- 228 235 !! NEMO/TOP 3.3.1 , NEMO Consortium (2010) … … 253 260 ! FABM <<<+++ 254 261 & ln_trc_sbc(jptra) , ln_trc_cbc(jptra) , ln_trc_obc(jptra) , & 262 & PGROW_AVG(jpi,jpj) , PLOSS_AVG(jpi,jpj) , PHYT_AVG(jpi,jpj) , & 263 & MLD_MAX(jpi,jpj) , & 255 264 #endif 256 265 #if defined key_bdy -
branches/UKMO/AMM15_v3_6_STABLE_package_collate_coupling/NEMOGCM/NEMO/TOP_SRC/trcbc.F90
r10162 r10850 46 46 # include "domzgr_substitute.h90" 47 47 !!---------------------------------------------------------------------- 48 !! NEMO/OPA 3. 6 , NEMO Consortium (2015)48 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 49 49 !! $Id$ 50 50 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
Note: See TracChangeset
for help on using the changeset viewer.
