- Timestamp:
- 2018-11-13T18:21:16+01:00 (5 years ago)
- Location:
- branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO
- Files:
-
- 94 edited
- 5 copied
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90
r8400 r10302 50 50 USE ice 51 51 #endif 52 #if defined key_top 53 USE asmbgc, ONLY: asm_bgc_bkg_wri 54 #endif 55 USE timing 52 56 IMPLICIT NONE 53 57 PRIVATE … … 110 114 ! 111 115 ! ! Write the information 116 IF(nn_timing == 2) CALL timing_start('iom_rstput') 112 117 CALL iom_rstput( kt, nitbkg_r, inum, 'rdastp' , zdate ) 113 118 CALL iom_rstput( kt, nitbkg_r, inum, 'un' , un ) … … 121 126 ! CALL iom_rstput( kt, nitbkg_r, inum, 'gcx' , gcx ) 122 127 CALL iom_rstput( kt, nitbkg_r, inum, 'avt' , avt ) 128 IF(nn_timing == 2) CALL timing_stop('iom_rstput') 123 129 ! 130 #if defined key_top 131 CALL asm_bgc_bkg_wri( kt, inum ) 132 ! 133 #endif 124 134 CALL iom_close( inum ) 125 135 ENDIF … … 149 159 ! 150 160 ! ! Write the information 161 IF(nn_timing == 2) CALL timing_start('iom_rstput') 151 162 CALL iom_rstput( kt, nitdin_r, inum, 'rdastp' , zdate ) 152 163 CALL iom_rstput( kt, nitdin_r, inum, 'un' , un ) … … 165 176 ENDIF 166 177 #endif 178 IF(nn_timing == 2) CALL timing_stop('iom_rstput') 167 179 ! 168 180 CALL iom_close( inum ) -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90
r8400 r10302 44 44 #endif 45 45 USE sbc_oce ! Surface boundary condition variables. 46 USE asmbgc ! Biogeochemistry assimilation 46 47 47 48 IMPLICIT NONE … … 54 55 PUBLIC ssh_asm_inc !: Apply the SSH increment 55 56 PUBLIC seaice_asm_inc !: Apply the seaice increment 57 PUBLIC bgc_asm_inc !: Apply the biogeochemistry increments 56 58 57 59 #if defined key_asminc … … 67 69 LOGICAL, PUBLIC :: ln_sshinc = .FALSE. !: No sea surface height assimilation increment 68 70 LOGICAL, PUBLIC :: ln_seaiceinc !: No sea ice concentration increment 71 LOGICAL, PUBLIC :: lk_bgcinc = .FALSE. !: No biogeochemistry increments 69 72 LOGICAL, PUBLIC :: ln_salfix = .FALSE. !: Apply minimum salinity check 70 73 LOGICAL, PUBLIC :: ln_temnofreeze = .FALSE. !: Don't allow the temperature to drop below freezing … … 133 136 REAL(wp), POINTER, DIMENSION(:,:) :: hdiv ! 2D workspace 134 137 !! 135 NAMELIST/nam_asminc/ ln_bkgwri, 138 NAMELIST/nam_asminc/ ln_bkgwri, ln_balwri, & 136 139 & ln_trainc, ln_dyninc, ln_sshinc, & 140 & ln_phytobal, ln_slchltotinc, ln_slchldiainc, & 141 & ln_slchlnoninc, ln_schltotinc, ln_slphytotinc, & 142 & ln_slphydiainc, ln_slphynoninc, ln_spco2inc, & 143 & ln_sfco2inc, ln_plchltotinc, ln_pchltotinc, & 144 & ln_pno3inc, ln_psi4inc, ln_pdicinc, ln_palkinc, & 145 & ln_pphinc, ln_po2inc, & 137 146 & ln_asmdin, ln_asmiau, & 138 147 & nitbkg, nitdin, nitiaustr, nitiaufin, niaufn, & 139 148 & ln_salfix, salfixmin, nn_divdmp, & 140 & ln_seaiceinc, ln_temnofreeze 149 & ln_seaiceinc, ln_temnofreeze, & 150 & mld_choice_bgc, rn_maxchlinc 141 151 !!---------------------------------------------------------------------- 142 152 … … 161 171 WRITE(numout,*) 'asm_inc_init : Assimilation increment initialization :' 162 172 WRITE(numout,*) '~~~~~~~~~~~~' 163 WRITE(numout,*) ' Namelist nam asm: set assimilation increment parameters'173 WRITE(numout,*) ' Namelist nam_asminc : set assimilation increment parameters' 164 174 WRITE(numout,*) ' Logical switch for writing out background state ln_bkgwri = ', ln_bkgwri 175 WRITE(numout,*) ' Logical switch for writing out balancing increments ln_balwri = ', ln_balwri 165 176 WRITE(numout,*) ' Logical switch for applying tracer increments ln_trainc = ', ln_trainc 166 177 WRITE(numout,*) ' Logical switch for applying velocity increments ln_dyninc = ', ln_dyninc … … 168 179 WRITE(numout,*) ' Logical switch for Direct Initialization (DI) ln_asmdin = ', ln_asmdin 169 180 WRITE(numout,*) ' Logical switch for applying sea ice increments ln_seaiceinc = ', ln_seaiceinc 181 WRITE(numout,*) ' Logical switch for phytoplankton balancing ln_phytobal = ', ln_phytobal 182 WRITE(numout,*) ' Logical switch for applying slchltot increments ln_slchltotinc = ', ln_slchltotinc 183 WRITE(numout,*) ' Logical switch for applying slchldia increments ln_slchldiainc = ', ln_slchldiainc 184 WRITE(numout,*) ' Logical switch for applying slchlnon increments ln_slchlnoninc = ', ln_slchlnoninc 185 WRITE(numout,*) ' Logical switch for applying schltot increments ln_schltotinc = ', ln_schltotinc 186 WRITE(numout,*) ' Logical switch for applying slphytot increments ln_slphytotinc = ', ln_slphytotinc 187 WRITE(numout,*) ' Logical switch for applying slphydia increments ln_slphydiainc = ', ln_slphydiainc 188 WRITE(numout,*) ' Logical switch for applying slphynon increments ln_slphynoninc = ', ln_slphynoninc 189 WRITE(numout,*) ' Logical switch for applying spco2 increments ln_spco2inc = ', ln_spco2inc 190 WRITE(numout,*) ' Logical switch for applying sfco2 increments ln_sfco2inc = ', ln_sfco2inc 191 WRITE(numout,*) ' Logical switch for applying plchltot increments ln_plchltotinc = ', ln_plchltotinc 192 WRITE(numout,*) ' Logical switch for applying pchltot increments ln_pchltotinc = ', ln_pchltotinc 193 WRITE(numout,*) ' Logical switch for applying pno3 increments ln_pno3inc = ', ln_pno3inc 194 WRITE(numout,*) ' Logical switch for applying psi4 increments ln_psi4inc = ', ln_psi4inc 195 WRITE(numout,*) ' Logical switch for applying pdic increments ln_pdicinc = ', ln_pdicinc 196 WRITE(numout,*) ' Logical switch for applying palk increments ln_palkinc = ', ln_palkinc 197 WRITE(numout,*) ' Logical switch for applying pph increments ln_pphinc = ', ln_pphinc 198 WRITE(numout,*) ' Logical switch for applying po2 increments ln_po2inc = ', ln_po2inc 170 199 WRITE(numout,*) ' Logical switch for Incremental Analysis Updating (IAU) ln_asmiau = ', ln_asmiau 171 200 WRITE(numout,*) ' Timestep of background in [0,nitend-nit000-1] nitbkg = ', nitbkg … … 176 205 WRITE(numout,*) ' Logical switch for ensuring that the sa > salfixmin ln_salfix = ', ln_salfix 177 206 WRITE(numout,*) ' Minimum salinity after applying the increments salfixmin = ', salfixmin 207 WRITE(numout,*) ' Choice of MLD for BGC assimilation mld_choice_bgc = ', mld_choice_bgc 208 WRITE(numout,*) ' Maximum absolute chlorophyll increment (<=0 = off) rn_maxchlinc = ', rn_maxchlinc 178 209 ENDIF 179 210 … … 212 243 WRITE(numout,*) ' iitiaufin_date = ', iitiaufin_date 213 244 ENDIF 245 246 IF ( ln_slchltotinc .OR. ln_slchldiainc .OR. ln_slchlnoninc .OR. & 247 & ln_schltotinc .OR. ln_slphytotinc .OR. ln_slphydiainc .OR. & 248 & ln_slphynoninc .OR. ln_spco2inc .OR. ln_sfco2inc .OR. & 249 & ln_plchltotinc .OR. ln_pchltotinc .OR. ln_pno3inc .OR. & 250 & ln_psi4inc .OR. ln_pdicinc .OR. ln_palkinc .OR. & 251 & ln_pphinc .OR. ln_po2inc ) THEN 252 lk_bgcinc = .TRUE. 253 ENDIF 214 254 215 255 IF ( nacc /= 0 ) & … … 223 263 224 264 IF ( ( ( .NOT. ln_asmdin ).AND.( .NOT. ln_asmiau ) ) & 225 .AND.( ( ln_trainc ).OR.( ln_dyninc ).OR.( ln_sshinc ) .OR. ( ln_seaiceinc) )) & 226 & CALL ctl_stop( ' One or more of ln_trainc, ln_dyninc, ln_sshinc and ln_seaiceinc is set to .true.', & 265 & .AND.( ( ln_trainc ).OR.( ln_dyninc ).OR.( ln_sshinc ).OR.( ln_seaiceinc ).OR. & 266 & ( lk_bgcinc ) )) & 267 & CALL ctl_stop( ' One or more of ln_trainc, ln_dyninc, ln_sshinc, ln_seaiceinc,', & 268 & ' ln_(bgc-variable)inc is set to .true.', & 227 269 & ' but ln_asmdin and ln_asmiau are both set to .false. :', & 228 270 & ' Inconsistent options') … … 233 275 234 276 IF ( ( .NOT. ln_trainc ).AND.( .NOT. ln_dyninc ).AND.( .NOT. ln_sshinc ).AND.( .NOT. ln_seaiceinc ) & 235 & ) & 236 & CALL ctl_warn( ' ln_trainc, ln_dyninc, ln_sshinc and ln_seaiceinc are set to .false. :', & 277 & .AND.( .NOT. lk_bgcinc ) ) & 278 & CALL ctl_warn( ' ln_trainc, ln_dyninc, ln_sshinc, ln_seaiceinc,', & 279 & ' ln_(bgc-variable)inc are set to .false. :', & 237 280 & ' The assimilation increments are not applied') 238 281 … … 254 297 & ' Background time step for Direct Initialization is outside', & 255 298 & ' the cycle interval') 299 300 IF ( lk_bgcinc ) CALL asm_bgc_check_options 256 301 257 302 IF ( nstop > 0 ) RETURN ! if there are any errors then go no further … … 350 395 ssh_iau(:,:) = 0.0 351 396 #endif 352 IF ( ( ln_trainc ).OR.( ln_dyninc ).OR.( ln_sshinc ).OR.( ln_seaiceinc ) ) THEN 397 IF ( ( ln_trainc ).OR.( ln_dyninc ).OR.( ln_sshinc ).OR.( ln_seaiceinc ) & 398 & .OR.( lk_bgcinc ) ) THEN 353 399 354 400 !-------------------------------------------------------------------- … … 424 470 ENDIF 425 471 472 IF ( lk_bgcinc ) THEN 473 CALL asm_bgc_init_incs( inum ) 474 ENDIF 475 426 476 CALL iom_close( inum ) 427 477 … … 534 584 CALL iom_close( inum ) 535 585 586 ENDIF 587 588 IF ( lk_bgcinc ) THEN 589 CALL asm_bgc_init_bkg 536 590 ENDIF 537 591 ! … … 1155 1209 1156 1210 END SUBROUTINE seaice_asm_inc 1211 1212 1213 SUBROUTINE bgc_asm_inc( kt ) 1214 !!---------------------------------------------------------------------- 1215 !! *** ROUTINE bgc_asm_inc *** 1216 !! 1217 !! ** Purpose : Apply the biogeochemistry assimilation increments 1218 !! 1219 !! ** Method : Call relevant routines in asmbgc 1220 !! 1221 !! ** Action : Call relevant routines in asmbgc 1222 !! 1223 !!---------------------------------------------------------------------- 1224 !! 1225 INTEGER, INTENT(in ) :: kt ! Current time step 1226 ! 1227 INTEGER :: icycper ! Dimension of wgtiau 1228 !! 1229 !!---------------------------------------------------------------------- 1230 1231 icycper = SIZE( wgtiau ) 1232 1233 ! Ocean colour variables first 1234 IF ( ln_slchltotinc .OR. ln_slchldiainc .OR. ln_slchlnoninc .OR. & 1235 & ln_schltotinc .OR. ln_slphytotinc .OR. ln_slphydiainc .OR. & 1236 & ln_slphynoninc ) THEN 1237 CALL phyto2d_asm_inc( kt, ln_asmdin, ln_asmiau, icycper, wgtiau ) 1238 ENDIF 1239 1240 ! Surface pCO2/fCO2 next 1241 IF ( ln_sfco2inc .OR. ln_spco2inc ) THEN 1242 CALL pco2_asm_inc( kt, ln_asmdin, ln_asmiau, icycper, wgtiau, & 1243 & ln_trainc, t_bkginc, s_bkginc ) 1244 ENDIF 1245 1246 ! Profile pH next 1247 IF ( ln_pphinc ) THEN 1248 CALL ph_asm_inc( kt, ln_asmdin, ln_asmiau, icycper, wgtiau, & 1249 & ln_trainc, t_bkginc, s_bkginc ) 1250 ENDIF 1251 1252 ! Then chlorophyll profiles 1253 IF ( ln_plchltotinc .OR. ln_pchltotinc ) THEN 1254 CALL phyto3d_asm_inc( kt, ln_asmdin, ln_asmiau, icycper, wgtiau ) 1255 ENDIF 1256 1257 ! Remaining bgc profile variables 1258 IF ( ln_pno3inc .OR. ln_psi4inc .OR. ln_pdicinc .OR. & 1259 & ln_palkinc .OR. ln_po2inc ) THEN 1260 CALL bgc3d_asm_inc( kt, ln_asmdin, ln_asmiau, icycper, wgtiau ) 1261 ENDIF 1262 1263 END SUBROUTINE bgc_asm_inc 1157 1264 1158 1265 !!====================================================================== -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/ASM/asmpar.F90
r6486 r10302 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/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90
r6486 r10302 150 150 CONTAINS 151 151 SUBROUTINE bdy_dyn( kt ) ! Empty routine 152 IMPLICIT NONE 153 INTEGER, INTENT( in ) :: kt ! Main time step counter 152 154 WRITE(*,*) 'bdy_dyn: You should not have seen this print! error?', kt 153 155 END SUBROUTINE bdy_dyn -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90
r6486 r10302 309 309 CONTAINS 310 310 SUBROUTINE bdy_dyn3d( kt ) ! Empty routine 311 WRITE(*,*) 'bdy_dyn3d: You should not have seen this print! error?', kt 311 IMPLICIT NONE 312 INTEGER, INTENT( in ) :: kt ! Main time step counter 313 WRITE(*,*) 'bdy_dyn3d: You should not have seen this print! error?', kt 312 314 END SUBROUTINE bdy_dyn3d 313 315 314 316 SUBROUTINE bdy_dyn3d_dmp( kt ) ! Empty routine 315 WRITE(*,*) 'bdy_dyn3d_dmp: You should not have seen this print! error?', kt 317 IMPLICIT NONE 318 INTEGER, INTENT( in ) :: kt ! Main time step counter 319 WRITE(*,*) 'bdy_dyn3d_dmp: You should not have seen this print! error?', kt 316 320 END SUBROUTINE bdy_dyn3d_dmp 317 321 -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90
r6487 r10302 611 611 CONTAINS 612 612 SUBROUTINE bdytide_init ! Empty routine 613 IMPLICIT NONE 613 614 WRITE(*,*) 'bdytide_init: You should not have seen this print! error?' 614 615 END SUBROUTINE bdytide_init 615 616 SUBROUTINE bdytide_update( kt, jit ) ! Empty routine 617 IMPLICIT NONE 618 INTEGER, INTENT( in ) :: kt ! Main timestep counter 619 INTEGER,INTENT(in),OPTIONAL :: jit ! Barotropic timestep counter (for timesplitting option) 616 620 WRITE(*,*) 'bdytide_update: You should not have seen this print! error?', kt, jit 617 621 END SUBROUTINE bdytide_update 618 622 SUBROUTINE bdy_dta_tides( kt, kit, time_offset ) ! Empty routine 623 IMPLICIT NONE 619 624 INTEGER, INTENT( in ) :: kt ! Dummy argument empty routine 620 625 INTEGER, INTENT( in ),OPTIONAL :: kit ! Dummy argument empty routine 621 626 INTEGER, INTENT( in ),OPTIONAL :: time_offset ! Dummy argument empty routine 622 WRITE(*,*) 'bdy_dta_tides: You should not have seen this print! error?', kt, jit627 WRITE(*,*) 'bdy_dta_tides: You should not have seen this print! error?', kt, kit 623 628 END SUBROUTINE bdy_dta_tides 624 629 #endif -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90
r6486 r10302 319 319 CONTAINS 320 320 SUBROUTINE bdy_tra(kt) ! Empty routine 321 IMPLICIT NONE 322 INTEGER, INTENT( in ) :: kt ! Main time step counter 321 323 WRITE(*,*) 'bdy_tra: You should not have seen this print! error?', kt 322 324 END SUBROUTINE bdy_tra 323 325 324 326 SUBROUTINE bdy_tra_dmp(kt) ! Empty routine 327 IMPLICIT NONE 328 INTEGER, INTENT( in ) :: kt ! Main time step counter 325 329 WRITE(*,*) 'bdy_tra_dmp: You should not have seen this print! error?', kt 326 330 END SUBROUTINE bdy_tra_dmp -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90
r6487 r10302 178 178 CONTAINS 179 179 SUBROUTINE bdy_vol( kt ) ! Empty routine 180 IMPLICIT NONE 181 INTEGER, INTENT( in ) :: kt ! ocean time-step index 180 182 WRITE(*,*) 'bdy_vol: You should not have seen this print! error?', kt 181 183 END SUBROUTINE bdy_vol -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/C1D/dyncor_c1d.F90
r6486 r10302 116 116 CONTAINS 117 117 SUBROUTINE cor_c1d ! Empty routine 118 IMPLICIT NONE 118 119 END SUBROUTINE cor_c1d 120 119 121 SUBROUTINE dyn_cor_c1d ( kt ) ! Empty routine 122 IMPLICIT NONE 123 INTEGER, INTENT( in ) :: kt ! ocean time-step index 120 124 WRITE(*,*) 'dyn_cor_c1d: You should not have seen this print! error?', kt 121 125 END SUBROUTINE dyn_cor_c1d -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90
r6486 r10302 165 165 !!---------------------------------------------------------------------- 166 166 CONTAINS 167 SUBROUTINE stp_c1d ( kt ) ! dummy routine 168 WRITE(*,*) 'stp_c1d: You should not have seen this print! error?', kt 167 SUBROUTINE stp_c1d ( kstp ) ! dummy routine 168 IMPLICIT NONE 169 INTEGER, INTENT(in) :: kstp ! ocean time-step index 170 WRITE(*,*) 'stp_c1d: You should not have seen this print! error?', kstp 169 171 END SUBROUTINE stp_c1d 170 172 #endif -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90
r6486 r10302 1302 1302 1303 1303 SUBROUTINE dia_dct_init ! Dummy routine 1304 WRITE(*,*) 'dia_dct_init: You should not have seen this print! error?', kt 1304 IMPLICIT NONE 1305 WRITE(*,*) 'dia_dct_init: You should not have seen this print! error?' 1305 1306 END SUBROUTINE dia_dct_init 1306 1307 1307 1308 SUBROUTINE dia_dct( kt ) ! Dummy routine 1309 IMPLICIT NONE 1308 1310 INTEGER, INTENT( in ) :: kt ! ocean time-step index 1309 1311 WRITE(*,*) 'dia_dct: You should not have seen this print! error?', kt -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r6487 r10302 254 254 IF(lwp) WRITE(numout,*) ' dia_hsb_rst at it= ', kt,' date= ', ndastp 255 255 IF(lwp) WRITE(numout,*) '~~~~~~~' 256 IF(nn_timing == 2) CALL timing_start('iom_rstget') 256 257 CALL iom_get( numror, 'frc_v', frc_v ) 257 258 CALL iom_get( numror, 'frc_t', frc_t ) … … 269 270 CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini ) 270 271 ENDIF 272 IF(nn_timing == 2) CALL timing_stop('iom_rstget') 271 273 ELSE 272 274 IF(lwp) WRITE(numout,*) '~~~~~~~' … … 304 306 IF(lwp) WRITE(numout,*) ' dia_hsb_rst at it= ', kt,' date= ', ndastp 305 307 IF(lwp) WRITE(numout,*) '~~~~~~~' 306 308 IF(nn_timing == 2) CALL timing_start('iom_rstput') 307 309 CALL iom_rstput( kt, nitrst, numrow, 'frc_v' , frc_v ) 308 310 CALL iom_rstput( kt, nitrst, numrow, 'frc_t' , frc_t ) … … 320 322 CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini ) 321 323 ENDIF 324 IF(nn_timing == 2) CALL timing_stop('iom_rstput') 322 325 ! 323 326 ENDIF -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90
r6486 r10302 343 343 CONTAINS 344 344 SUBROUTINE dia_hth( kt ) ! Empty routine 345 WRITE(*,*) 'dia_hth: You should not have seen this print! error?', kt 345 IMPLICIT NONE 346 INTEGER, INTENT( in ) :: kt ! ocean time-step index 347 WRITE(*,*) 'dia_hth: You should not have seen this print! error?', kt 346 348 END SUBROUTINE dia_hth 347 349 #endif -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
r7747 r10302 84 84 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace 85 85 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d ! 3D workspace 86 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvn ! 3D workspace 86 87 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask ! 3D workspace 87 88 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zts ! 3D workspace … … 93 94 REAL(wp), DIMENSION(jpj,jpk,nptr) :: sjk , r1_sjk ! i-mean i-k-surface and its inverse 94 95 REAL(wp), DIMENSION(jpj,jpk,nptr) :: v_msf, sn_jk , tn_jk ! i-mean T and S, j-Stream-Function 95 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvn ! 3D workspace96 96 97 97 … … 102 102 103 103 ! 104 z2d(:,:) = 0._wp 104 105 z3d(:,:,:) = 0._wp 105 106 IF( PRESENT( pvtr ) ) THEN … … 130 131 zmask(:,:,:) = 0._wp 131 132 zts(:,:,:,:) = 0._wp 132 zvn(:,:,:) = 0._wp133 133 DO jk = 1, jpkm1 134 134 DO jj = 1, jpjm1 … … 138 138 zts(ji,jj,jk,jp_tem) = (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) * 0.5 * zvfc !Tracers averaged onto V grid 139 139 zts(ji,jj,jk,jp_sal) = (tsn(ji,jj,jk,jp_sal)+tsn(ji,jj+1,jk,jp_sal)) * 0.5 * zvfc 140 zvn(ji,jj,jk) = vn(ji,jj,jk) * zvfc141 140 ENDDO 142 141 ENDDO … … 151 150 tn_jk(:,:,1) = ptr_sjk( zts(:,:,:,jp_tem) ) * r1_sjk(:,:,1) 152 151 sn_jk(:,:,1) = ptr_sjk( zts(:,:,:,jp_sal) ) * r1_sjk(:,:,1) 153 v_msf(:,:,1) = ptr_sjk( zvn(:,:,:) )152 v_msf(:,:,1) = ptr_sjk( pvtr(:,:,:) ) 154 153 155 154 htr_ove(:,1) = SUM( v_msf(:,:,1)*tn_jk(:,:,1) ,2 ) … … 177 176 tn_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 178 177 sn_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 179 v_msf(:,:,jn) = ptr_sjk( zvn(:,:,:), btmsk(:,:,jn) )178 v_msf(:,:,jn) = ptr_sjk( pvtr(:,:,:), btmsk(:,:,jn) ) 180 179 htr_ove(:,jn) = SUM( v_msf(:,:,jn)*tn_jk(:,:,jn) ,2 ) 181 180 str_ove(:,jn) = SUM( v_msf(:,:,jn)*sn_jk(:,:,jn) ,2 ) … … 202 201 WHERE( sjk(:,1,1) /= 0._wp ) r1_sjk(:,1,1) = 1._wp / sjk(:,1,1) 203 202 204 vsum = ptr_sj( zvn(:,:,:), btmsk(:,:,1))203 vsum = ptr_sj( pvtr(:,:,:), btmsk(:,:,1)) 205 204 tssum(:,jp_tem) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,1) ) 206 205 tssum(:,jp_sal) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,1) ) … … 224 223 r1_sjk(:,1,jn) = 0._wp 225 224 WHERE( sjk(:,1,jn) /= 0._wp ) r1_sjk(:,1,jn) = 1._wp / sjk(:,1,jn) 226 vsum = ptr_sj( zvn(:,:,:), btmsk(:,:,jn))225 vsum = ptr_sj( pvtr(:,:,:), btmsk(:,:,jn)) 227 226 tssum(:,jp_tem) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) 228 227 tssum(:,jp_sal) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) … … 248 247 ! 249 248 IF( iom_use("zotemglo") ) THEN ! i-mean i-k-surface 249 zmask(:,:,:) = 0._wp 250 zts(:,:,:,:) = 0._wp 250 251 DO jk = 1, jpkm1 251 252 DO jj = 1, jpj … … 408 409 ENDIF 409 410 IF( iom_use("zomsfeivglo") ) THEN 410 z3d(1,:,:) = ptr_sjk( v_eiv(:,:,:) ) ! zonal cumulative effective transport 411 DO jk=1,jpk 412 DO jj=1,jpj 413 DO ji=1,jpi 414 zvn(ji,jj,jk) = v_eiv(ji,jj,jk) * fse3v(ji,jj,jk) * e1v(ji,jj) 415 ENDDO 416 ENDDO 417 ENDDO 418 z3d(1,:,:) = ptr_sjk( zvn(:,:,:) ) ! zonal cumulative effective transport 411 419 DO jk = jpkm1,1,-1 412 420 z3d(1,:,jk) = z3d(1,:,jk+1) - z3d(1,:,jk) ! effective j-Stream-Function (MSF) … … 419 427 IF( ln_subbas ) THEN 420 428 DO jn = 2, nptr ! by sub-basins 421 z3d(1,:,:) = ptr_sjk( v_eiv(:,:,:), btmsk(:,:,jn) )429 z3d(1,:,:) = ptr_sjk( zvn(:,:,:), btmsk(:,:,jn) ) 422 430 DO jk = jpkm1,1,-1 423 431 z3d(1,:,jk) = z3d(1,:,jk+1) - z3d(1,:,jk) ! effective j-Stream-Function (MSF) … … 492 500 493 501 IF( ln_subbas ) THEN ! load sub-basin mask 494 CALL iom_open( 'subbasins', inum, ldstop = . FALSE. )502 CALL iom_open( 'subbasins', inum, ldstop = .TRUE. ) 495 503 CALL iom_get( inum, jpdom_data, 'atlmsk', btmsk(:,:,2) ) ! Atlantic basin 496 504 CALL iom_get( inum, jpdom_data, 'pacmsk', btmsk(:,:,3) ) ! Pacific basin -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r8400 r10302 246 246 z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:) 247 247 END DO 248 CALL lbc_lnk( z3d(:,:,:), 'W', 1. ) 248 249 CALL iom_put( "w_masstr" , z3d ) 249 250 IF( iom_use('w_masstr2') ) CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) ) … … 252 253 CALL iom_put( "avt" , avt ) ! T vert. eddy diff. coef. 253 254 CALL iom_put( "avm" , avmu ) ! T vert. eddy visc. coef. 255 #if defined key_zdftke 254 256 IF( lk_zdftke ) THEN 255 257 CALL iom_put( "tke" , en ) ! TKE budget: Turbulent Kinetic Energy 256 258 CALL iom_put( "tke_niw" , e_niw ) ! TKE budget: Near-inertial waves 257 259 ENDIF 260 #endif 258 261 CALL iom_put( "avs" , fsavs(:,:,:) ) ! S vert. eddy diff. coef. (useful only with key_zdfddm) 259 262 ! Log of eddy diff coef … … 334 337 z2d(:,:) = z2d(:,:) + z3d(:,:,jk) 335 338 END DO 339 CALL lbc_lnk( z3d(:,:,:), 'U', -1. ) 336 340 CALL iom_put( "u_masstr", z3d ) ! mass transport in i-direction 341 CALL lbc_lnk( z2d(:,:), 'U', -1. ) 337 342 CALL iom_put( "u_masstr_vint", z2d ) ! mass transport in i-direction vertical sum 338 343 ENDIF … … 370 375 z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) * vmask(:,:,jk) 371 376 END DO 377 CALL lbc_lnk( z3d(:,:,:), 'V', -1. ) 372 378 CALL iom_put( "v_masstr", z3d ) ! mass transport in j-direction 373 379 ENDIF -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90
r6487 r10302 309 309 IF( iom_varid( numror, 'kt', ldstop = .FALSE. ) > 0 ) THEN 310 310 ! Get Calendar informations 311 IF(nn_timing == 2) CALL timing_start('iom_rstget') 311 312 CALL iom_get( numror, 'kt', zkt ) ! last time-step of previous run 313 IF(nn_timing == 2) CALL timing_stop('iom_rstget') 312 314 IF(lwp) THEN 313 315 WRITE(numout,*) ' *** Info read in restart : ' … … 327 329 ! define ndastp and adatrj 328 330 IF ( nrstdt == 2 ) THEN 331 IF(nn_timing == 2) CALL timing_start('iom_rstget') 329 332 ! read the parameters correspondting to nit000 - 1 (last time step of previous run) 330 333 CALL iom_get( numror, 'ndastp', zndastp ) 331 334 ndastp = NINT( zndastp ) 332 335 CALL iom_get( numror, 'adatrj', adatrj ) 336 IF(nn_timing == 2) CALL timing_stop('iom_rstget') 333 337 ELSE 334 338 ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day) … … 359 363 ENDIF 360 364 ! calendar control 365 IF(nn_timing == 2) CALL timing_start('iom_rstput') 361 366 CALL iom_rstput( kt, nitrst, numrow, 'kt' , REAL( kt , wp) ) ! time-step 362 367 CALL iom_rstput( kt, nitrst, numrow, 'ndastp' , REAL( ndastp, wp) ) ! date 363 368 CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj ) ! number of elapsed days since 364 369 ! ! the begining of the run [s] 370 IF(nn_timing == 2) CALL timing_stop('iom_rstput') 365 371 ENDIF 366 372 ! -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
r8427 r10302 254 254 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: bathy !: ocean depth (meters) 255 255 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmask_i, umask_i, vmask_i, fmask_i !: interior domain T-point mask 256 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tmask_i_diag !: partial mask for use in T diagnostic mask calc. 257 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: umask_i_diag !: partial mask for use in U diagnostic mask calc. 258 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: vmask_i_diag !: partial mask for use in V diagnostic mask calc. 256 259 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: bmask !: land/ocean mask of barotropic stream function 257 260 … … 406 409 407 410 ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk), & 408 & vmask(jpi,jpj,jpk) , fmask(jpi,jpj,jpk), STAT=ierr(11) ) 411 & vmask(jpi,jpj,jpk) , fmask(jpi,jpj,jpk), & 412 tmask_i_diag(jpi,jpj,jpk), & 413 umask_i_diag(jpi,jpj,jpk), & 414 vmask_i_diag(jpi,jpj,jpk), & 415 STAT=ierr(11) ) 409 416 410 417 ALLOCATE( wmask(jpi,jpj,jpk) , wumask(jpi,jpj,jpk), wvmask(jpi,jpj,jpk) , STAT=ierr(12) ) -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
r8280 r10302 1 1 2 MODULE dommsk 2 3 !!====================================================================== … … 30 31 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient 31 32 USE wrk_nemo ! Memory allocation 33 USE domwri 32 34 USE timing ! Timing 33 35 … … 138 140 REAL(wp) :: zphi_drake_passage, zshlat_antarc 139 141 REAL(wp), POINTER, DIMENSION(:,:) :: zwf 142 REAL(wp) :: uvt(jpi,jpj) ! dummy array for masking purposes. 140 143 !! 141 144 NAMELIST/namlbc/ rn_shlat, ln_vorlat … … 223 226 ! -------------------- 224 227 tmask_i(:,:) = ssmask(:,:) ! (ISH) tmask_i = 1 even on the ice shelf 228 225 229 iif = jpreci ! ??? 226 230 iil = nlci - jpreci + 1 … … 246 250 ENDIF 247 251 ENDIF 252 253 248 254 IF( jperio == 5 .OR. jperio == 6 ) THEN ! F-point pivot 249 255 tpol( 1 :jpiglo) = 0._wp … … 263 269 & * tmask(ji,jj+1,jk) * tmask(ji+1,jj+1,jk) 264 270 END DO 265 END DO 271 END DO 266 272 END DO 267 273 ! (ISF) MIN(1,SUM(umask)) is here to check if you have effectively at least 1 wet u point … … 282 288 CALL lbc_lnk( vmask_i, 'V', 1._wp ) 283 289 CALL lbc_lnk( fmask_i, 'F', 1._wp ) 290 291 292 ! Set up mask for diagnostics on T points, to exclude duplicate 293 ! data points in wrap and N-fold regions. 294 CALL dom_uniq( uvt, 'T' ) 295 DO jk = 1, jpk 296 tmask_i_diag(:,:,jk) = tmask(:,:,jk) * uvt(:,:) 297 END DO 298 299 ! Set up mask for diagnostics on U points, to exclude duplicate 300 ! data points in wrap and N-fold regions. 301 umask_i_diag(:,:,:) = 1.0 302 umask_i_diag(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:) 303 CALL lbc_lnk( umask_i_diag, 'U', 1. ) 304 305 ! Now mask out any duplicate points 306 CALL dom_uniq( uvt, 'U' ) 307 DO jk = 1, jpk 308 umask_i_diag(:,:,jk) = umask_i_diag(:,:,jk) * uvt(:,:) 309 END DO 310 311 312 ! Set up mask for diagnostics on V points, to exclude duplicate 313 ! data points in wrap and N-fold regions. 314 vmask_i_diag(:,:,:) = 1.0 315 vmask_i_diag(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:) 316 CALL lbc_lnk( vmask_i_diag, 'V', 1. ) 317 318 ! Now mask out any duplicate points 319 CALL dom_uniq( uvt, 'V' ) 320 DO jk = 1, jpk 321 vmask_i_diag(:,:,jk) = vmask_i_diag(:,:,jk) * uvt(:,:) 322 END DO 323 324 284 325 285 326 ! 3. Ocean/land mask at wu-, wv- and w points -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
r6498 r10302 817 817 IF( ln_rstart ) THEN !* Read the restart file 818 818 CALL rst_read_open ! open the restart file if necessary 819 IF(nn_timing == 2) CALL timing_start('iom_rstget') 819 820 CALL iom_get( numror, jpdom_autoglo, 'sshn' , sshn ) 820 821 ! … … 892 893 ENDIF 893 894 ! 895 IF(nn_timing == 2) CALL timing_stop('iom_rstget') 894 896 ELSE !* Initialize at "rest" 895 897 fse3t_b(:,:,:) = e3t_0(:,:,:) … … 908 910 ! ! --------- ! 909 911 ! ! all cases ! 910 ! ! --------- ! 912 ! ! --------- ! 913 IF(nn_timing == 2) CALL timing_start('iom_rstput') 911 914 CALL iom_rstput( kt, nitrst, numrow, 'fse3t_b', fse3t_b(:,:,:) ) 912 915 CALL iom_rstput( kt, nitrst, numrow, 'fse3t_n', fse3t_n(:,:,:) ) … … 922 925 CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:) ) 923 926 ENDIF 927 IF(nn_timing == 2) CALL timing_stop('iom_rstput') 924 928 925 929 ENDIF -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90
r6487 r10302 26 26 PRIVATE 27 27 28 PUBLIC dom_wri ! routine called by inidom.F9028 PUBLIC dom_wri, dom_uniq ! routines called by inidom.F90 and iom.F90 29 29 30 30 !! * Substitutions … … 126 126 127 127 ! ! masks (inum2) 128 IF(nn_timing == 2) CALL timing_start('iom_rstput') 128 129 CALL iom_rstput( 0, 0, inum2, 'tmask', tmask, ktype = jp_i1 ) ! ! land-sea mask 129 130 CALL iom_rstput( 0, 0, inum2, 'umask', umask, ktype = jp_i1 ) 130 131 CALL iom_rstput( 0, 0, inum2, 'vmask', vmask, ktype = jp_i1 ) 131 132 CALL iom_rstput( 0, 0, inum2, 'fmask', fmask, ktype = jp_i1 ) 133 IF(nn_timing == 2) CALL timing_stop('iom_rstput') 132 134 133 135 CALL dom_uniq( zprw, 'T' ) … … 138 140 END DO 139 141 END DO ! ! unique point mask 142 IF(nn_timing == 2) CALL timing_start('iom_rstput') 140 143 CALL iom_rstput( 0, 0, inum2, 'tmaskutil', zprt, ktype = jp_i1 ) 144 IF(nn_timing == 2) CALL timing_stop('iom_rstput') 141 145 CALL dom_uniq( zprw, 'U' ) 142 146 DO jj = 1, jpj … … 146 150 END DO 147 151 END DO 152 IF(nn_timing == 2) CALL timing_start('iom_rstput') 148 153 CALL iom_rstput( 0, 0, inum2, 'umaskutil', zprt, ktype = jp_i1 ) 154 IF(nn_timing == 2) CALL timing_stop('iom_rstput') 149 155 CALL dom_uniq( zprw, 'V' ) 150 156 DO jj = 1, jpj … … 154 160 END DO 155 161 END DO 162 IF(nn_timing == 2) CALL timing_start('iom_rstput') 156 163 CALL iom_rstput( 0, 0, inum2, 'vmaskutil', zprt, ktype = jp_i1 ) 164 IF(nn_timing == 2) CALL timing_stop('iom_rstput') 157 165 CALL dom_uniq( zprw, 'F' ) 158 166 DO jj = 1, jpj … … 162 170 END DO 163 171 END DO 172 IF(nn_timing == 2) CALL timing_start('iom_rstput') 164 173 CALL iom_rstput( 0, 0, inum2, 'fmaskutil', zprt, ktype = jp_i1 ) 165 174 … … 218 227 CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0, ktype = jp_r4 ) 219 228 ENDIF 220 229 IF(nn_timing == 2) CALL timing_stop('iom_rstput') 221 230 IF( ln_zps ) THEN ! z-coordinate - partial steps 222 231 ! 223 232 IF( nmsh <= 6 ) THEN ! ! 3D vertical scale factors 233 IF(nn_timing == 2) CALL timing_start('iom_rstput') 224 234 CALL iom_rstput( 0, 0, inum4, 'e3t_0', e3t_0 ) 225 235 CALL iom_rstput( 0, 0, inum4, 'e3u_0', e3u_0 ) 226 236 CALL iom_rstput( 0, 0, inum4, 'e3v_0', e3v_0 ) 227 237 CALL iom_rstput( 0, 0, inum4, 'e3w_0', e3w_0 ) 238 IF(nn_timing == 2) CALL timing_stop('iom_rstput') 228 239 ELSE ! ! 2D masked bottom ocean scale factors 229 240 DO jj = 1,jpj … … 233 244 END DO 234 245 END DO 246 IF(nn_timing == 2) CALL timing_start('iom_rstput') 235 247 CALL iom_rstput( 0, 0, inum4, 'e3t_ps', e3tp ) 236 248 CALL iom_rstput( 0, 0, inum4, 'e3w_ps', e3wp ) 249 IF(nn_timing == 2) CALL timing_stop('iom_rstput') 237 250 END IF 238 251 ! … … 248 261 END DO 249 262 CALL lbc_lnk( zdepu, 'U', 1. ) ; CALL lbc_lnk( zdepv, 'V', 1. ) 263 IF(nn_timing == 2) CALL timing_start('iom_rstput') 250 264 CALL iom_rstput( 0, 0, inum4, 'gdepu', zdepu, ktype = jp_r4 ) 251 265 CALL iom_rstput( 0, 0, inum4, 'gdepv', zdepv, ktype = jp_r4 ) 252 266 CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0, ktype = jp_r4 ) 267 IF(nn_timing == 2) CALL timing_stop('iom_rstput') 253 268 ELSE ! ! 2D bottom depth 254 269 DO jj = 1,jpj … … 258 273 END DO 259 274 END DO 275 IF(nn_timing == 2) CALL timing_start('iom_rstput') 260 276 CALL iom_rstput( 0, 0, inum4, 'hdept', zprt, ktype = jp_r4 ) 261 277 CALL iom_rstput( 0, 0, inum4, 'hdepw', zprw, ktype = jp_r4 ) 278 IF(nn_timing == 2) CALL timing_stop('iom_rstput') 262 279 ENDIF 263 280 ! 281 IF(nn_timing == 2) CALL timing_start('iom_rstput') 264 282 CALL iom_rstput( 0, 0, inum4, 'gdept_1d', gdept_1d ) ! ! reference z-coord. 265 283 CALL iom_rstput( 0, 0, inum4, 'gdepw_1d', gdepw_1d ) 266 284 CALL iom_rstput( 0, 0, inum4, 'e3t_1d' , e3t_1d ) 267 285 CALL iom_rstput( 0, 0, inum4, 'e3w_1d' , e3w_1d ) 286 IF(nn_timing == 2) CALL timing_stop('iom_rstput') 268 287 ENDIF 269 288 270 289 IF( ln_zco ) THEN 271 290 ! ! z-coordinate - full steps 291 IF(nn_timing == 2) CALL timing_start('iom_rstput') 272 292 CALL iom_rstput( 0, 0, inum4, 'gdept_1d', gdept_1d ) ! ! depth 273 293 CALL iom_rstput( 0, 0, inum4, 'gdepw_1d', gdepw_1d ) 274 294 CALL iom_rstput( 0, 0, inum4, 'e3t_1d' , e3t_1d ) ! ! scale factors 275 295 CALL iom_rstput( 0, 0, inum4, 'e3w_1d' , e3w_1d ) 296 IF(nn_timing == 2) CALL timing_stop('iom_rstput') 276 297 ENDIF 277 298 ! ! ============================ -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_exp.F90
r6486 r10302 107 107 CONTAINS 108 108 SUBROUTINE dyn_spg_exp( kt ) ! Empty routine 109 IMPLICIT NONE 110 INTEGER, INTENT(in) :: kt ! ocean time-step index 109 111 WRITE(*,*) 'dyn_spg_exp: You should not have seen this print! error?', kt 110 112 END SUBROUTINE dyn_spg_exp -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90
r7179 r10302 395 395 ! Caution : extra-hallow 396 396 ! gcx and gcxb are defined as: DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj) 397 IF(nn_timing == 2) CALL timing_start('iom_rstget') 397 398 CALL iom_get( numror, jpdom_autoglo, 'gcx' , gcx (1:jpi,1:jpj) ) 398 399 CALL iom_get( numror, jpdom_autoglo, 'gcxb', gcxb(1:jpi,1:jpj) ) 400 IF(nn_timing == 2) CALL timing_stop('iom_rstget') 399 401 IF( neuler == 0 ) gcxb(:,:) = gcx (:,:) 400 402 ELSE … … 405 407 ! Caution : extra-hallow 406 408 ! gcx and gcxb are defined as: DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj) 409 IF(nn_timing == 2) CALL timing_start('iom_rstput') 407 410 CALL iom_rstput( kt, nitrst, numrow, 'gcx' , gcx (1:jpi,1:jpj) ) 408 411 CALL iom_rstput( kt, nitrst, numrow, 'gcxb', gcxb(1:jpi,1:jpj) ) 412 IF(nn_timing == 2) CALL timing_stop('iom_rstput') 409 413 ENDIF 410 414 ! -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r6487 r10302 1019 1019 ! 1020 1020 IF( TRIM(cdrw) == 'READ' ) THEN 1021 IF(nn_timing == 2) CALL timing_start('iom_rstget') 1021 1022 CALL iom_get( numror, jpdom_autoglo, 'ub2_b' , ub2_b (:,:) ) 1022 1023 CALL iom_get( numror, jpdom_autoglo, 'vb2_b' , vb2_b (:,:) ) … … 1036 1037 ENDIF 1037 1038 #endif 1039 IF(nn_timing == 2) CALL timing_stop('iom_rstget') 1038 1040 ! 1039 1041 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN 1042 IF(nn_timing == 2) CALL timing_start('iom_rstput') 1040 1043 CALL iom_rstput( kt, nitrst, numrow, 'ub2_b' , ub2_b (:,:) ) 1041 1044 CALL iom_rstput( kt, nitrst, numrow, 'vb2_b' , vb2_b (:,:) ) … … 1056 1059 ENDIF 1057 1060 #endif 1061 IF(nn_timing == 2) CALL timing_stop('iom_rstput') 1058 1062 ENDIF 1059 1063 ! -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/FLO/floats.F90
r6486 r10302 146 146 CONTAINS 147 147 SUBROUTINE flo_stp( kt ) ! Empty routine 148 IMPLICIT NONE 149 INTEGER, INTENT( in ) :: kt ! ocean time step 148 150 WRITE(*,*) 'flo_stp: You should not have seen this print! error?', kt 149 151 END SUBROUTINE flo_stp -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/ICB/icbrst.F90
r6755 r10302 29 29 USE icb_oce ! define iceberg arrays 30 30 USE icbutl ! iceberg utility routines 31 USE timing 31 32 32 33 IMPLICIT NONE … … 71 72 TYPE(point) :: localpt ! NOT a pointer but an actual local variable 72 73 !!---------------------------------------------------------------------- 73 74 IF(nn_timing == 2) CALL timing_start('iom_rstget') 74 75 ! Find a restart file. Assume iceberg restarts in same directory as ocean restarts 75 76 ! and are called TRIM(cn_ocerst)//'_icebergs' … … 146 147 CALL iom_close( ncid ) 147 148 ! 149 IF(nn_timing == 2) CALL timing_stop('iom_rstget') 148 150 IF( lwp .and. nn_verbose_level >= 0) WRITE(numout,'(a)') 'icebergs, read_restart_bergs: completed' 149 151 ! … … 169 171 TYPE(point) , POINTER :: pt 170 172 !!---------------------------------------------------------------------- 171 173 IF(nn_timing == 2) CALL timing_start('iom_rstput') 172 174 ! Assume we write iceberg restarts to same directory as ocean restarts. 173 175 cl_path = TRIM(cn_ocerst_outdir) … … 374 376 nret = NF90_CLOSE(ncid) 375 377 IF (nret /= NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_close failed') 378 IF(nn_timing == 2) CALL timing_stop('iom_rstput') 376 379 ! 377 380 END SUBROUTINE icb_rst_write -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r8308 r10302 44 44 USE ioipsl, ONLY : ju2ymds ! for calendar 45 45 USE crs ! Grid coarsening 46 USE timing 46 47 47 48 IMPLICIT NONE … … 1399 1400 IF ( ln_mskland ) THEN 1400 1401 ! mask land points, keep values on coast line -> specific mask for U, V and W points 1402 1403 1401 1404 SELECT CASE ( cdgrd ) 1402 CASE('T') ; zmask(:,:,:) = tmask(:,:,:) 1403 CASE('U') ; zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:) ; CALL lbc_lnk( zmask, 'U', 1. ) 1404 CASE('V') ; zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:) ; CALL lbc_lnk( zmask, 'V', 1. ) 1405 CASE('W') ; zmask(:,:,2:jpk ) = tmask(:,:,1:jpkm1) + tmask(:,:,2:jpk) ; zmask(:,:,1) = tmask(:,:,1) 1406 END SELECT 1405 ! The masks applied here are specifically used to mask out duplicate 1406 ! data points in wrap columns and N-fold rows in order to ensure bit 1407 ! reproducibility of diagnostics which have not undergone an explicit 1408 ! lbc_lnk prior to writing. Such fields are prone to junk values at 1409 ! duplicate points since those points are often excluded from the 1410 ! core field computation process. 1411 CASE('T') 1412 zmask(:,:,:) = tmask_i_diag(:,:,:) 1413 CASE('U') 1414 zmask(:,:,:) = umask_i_diag(:,:,:) 1415 CASE('V') 1416 zmask(:,:,:) = vmask_i_diag(:,:,:) 1417 CASE('W') 1418 zmask(:,:,2:jpk ) = tmask_i_diag(:,:,1:jpkm1) + tmask_i_diag(:,:,2:jpk) 1419 zmask(:,:,1) = tmask_i_diag(:,:,1) 1420 END SELECT 1407 1421 ! 1408 1422 #if ! defined key_xios2 … … 1634 1648 WRITE(cl1,'(i1)') 2 ; CALL iom_set_field_attr('trendT_even' , freq_op=cl1//'ts', freq_offset='0ts') 1635 1649 WRITE(cl1,'(i1)') 2 ; CALL iom_set_field_attr('trendT_odd' , freq_op=cl1//'ts', freq_offset='-1ts') 1650 WRITE(cl1,'(i1)') 2 ; CALL iom_set_field_attr('ptrd_T_even' , freq_op=cl1//'ts', freq_offset='0ts') 1651 WRITE(cl1,'(i1)') 2 ; CALL iom_set_field_attr('ptrd_T_odd' , freq_op=cl1//'ts', freq_offset='-1ts') 1636 1652 WRITE(cl1,'(i1)') nn_fsbc ; CALL iom_set_field_attr('SBC' , freq_op=cl1//'ts', freq_offset='0ts') 1637 1653 WRITE(cl1,'(i1)') nn_fsbc ; CALL iom_set_field_attr('SBC_scalar' , freq_op=cl1//'ts', freq_offset='0ts') … … 1642 1658 f_op%timestep = 2 ; f_of%timestep = 0 ; CALL iom_set_field_attr('trendT_even' , freq_op=f_op, freq_offset=f_of) 1643 1659 f_op%timestep = 2 ; f_of%timestep = -1 ; CALL iom_set_field_attr('trendT_odd' , freq_op=f_op, freq_offset=f_of) 1660 f_op%timestep = 2 ; f_of%timestep = 0 ; CALL iom_set_field_attr('ptrd_T_even' , freq_op=f_op, freq_offset=f_of) 1661 f_op%timestep = 2 ; f_of%timestep = -1 ; CALL iom_set_field_attr('ptrd_T_odd' , freq_op=f_op, freq_offset=f_of) 1644 1662 f_op%timestep = nn_fsbc ; f_of%timestep = 0 ; CALL iom_set_field_attr('SBC' , freq_op=f_op, freq_offset=f_of) 1645 1663 f_op%timestep = nn_fsbc ; f_of%timestep = 0 ; CALL iom_set_field_attr('SBC_scalar' , freq_op=f_op, freq_offset=f_of) -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
r8046 r10302 26 26 USE divcur ! hor. divergence and curl (div & cur routines) 27 27 USE sbc_oce ! for icesheet freshwater input variables 28 USE timing 28 29 29 30 IMPLICIT NONE … … 134 135 INTEGER, INTENT(in) :: kt ! ocean time-step 135 136 !!---------------------------------------------------------------------- 136 137 IF(nn_timing == 2) CALL timing_start('iom_rstput') 137 138 CALL iom_rstput( kt, nitrst, numrow, 'rdt' , rdt ) ! dynamics time step 138 139 CALL iom_rstput( kt, nitrst, numrow, 'rdttra1', rdttra(1) ) ! surface tracer time step … … 168 169 ENDIF 169 170 ENDIF 171 IF(nn_timing == 2) CALL timing_stop('iom_rstput') 170 172 171 173 IF( kt == nitrst ) THEN … … 237 239 238 240 ! Check dynamics and tracer time-step consistency and force Euler restart if changed 241 IF(nn_timing == 2) CALL timing_start('iom_rstget') 239 242 IF( iom_varid( numror, 'rdt', ldstop = .FALSE. ) > 0 ) THEN 240 243 CALL iom_get( numror, 'rdt', zrdt ) … … 300 303 antarctica_icesheet_timelapsed = 0.0 301 304 ENDIF 302 305 IF(nn_timing == 2) CALL timing_stop('iom_rstget') 303 306 IF( neuler == 0 ) THEN ! Euler restart (neuler=0) 304 307 tsb (:,:,:,:) = tsn (:,:,:,:) ! all before fields set to now values -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c3d.h90
r6486 r10302 210 210 ! 211 211 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ztemp2d ! temporary array to read ahmcoef file 212 LOGICAL :: tempmask( jpi,jpj) ! Temporary mask to avoid Cray compiler bug at cce 8.3.4 212 213 !!---------------------------------------------------------------------- 213 214 ! … … 252 253 zemax = MAXVAL ( e1t(:,:) * e2t(:,:), tmask(:,:,1) .GE. 0.5 ) 253 254 zemin = MINVAL ( e1t(:,:) * e2t(:,:), tmask(:,:,1) .GE. 0.5 ) 254 zeref = MAXVAL ( e1t(:,:) * e2t(:,:), & 255 & tmask(:,:,1) .GE. 0.5 .AND. ABS(gphit(:,:)) .GT. 50. ) 255 tempmask(:,:) = .FALSE. 256 ! Pre calculate mask for zeref since embedding the following 257 ! term in the MAXVAL operation offends the Cray compiler for no 258 ! justifiable reason under certain conditions. 259 tempmask(:,:) = (tmask(:,:,1) .GE. 0.5) .AND. (ABS(gphit(:,:)) .GT. 50.) 260 zeref = MAXVAL ( e1t(:,:) * e2t(:,:), tempmask(:,:) ) 256 261 257 262 DO jj = 1, jpj -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_smag.F90
r6486 r10302 294 294 CONTAINS 295 295 SUBROUTINE ldf_dyn_smag( kt ) ! Empty routine 296 IMPLICIT NONE 297 INTEGER :: kt ! timestep 296 298 WRITE(*,*) 'ldf_dyn_smag: You should not have seen this print! error? check keys ldf:c3d+smag', kt 297 299 END SUBROUTINE ldf_dyn_smag -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_smag.F90
r6486 r10302 204 204 CONTAINS 205 205 SUBROUTINE ldf_tra_smag( kt ) ! Empty routine 206 WRITE(*,*) 'ldf_dyn_smag: You should not have seen this print! error? check keys ldf:c3d+smag', kt 206 IMPLICIT NONE 207 INTEGER, INTENT( in ) :: kt ! ocean time-step inedx 208 WRITE(*,*) 'ldf_dyn_smag: You should not have seen this print! error? check keys ldf:c3d+smag', kt 207 209 END SUBROUTINE ldf_tra_smag 208 210 #endif -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
r8280 r10302 151 151 INTEGER :: id_part 152 152 INTEGER :: paral(5) ! OASIS3 box partition 153 INTEGER :: ishape(2,2) ! shape of arrays passed to PSMILe 153 INTEGER :: ishape(4) ! Shape of arrays passed to PSMILe. 154 ! Redundant from OASIS3-MCT vn4.0 onwards but required 155 ! to satisfy interface and for backward compatibility. 156 INTEGER :: var_nodims(2) ! Number of coupling field dimensions. 157 ! var_nodims(1) is redundant from OASIS3-MCT vn4.0 onwards 158 ! but retained for backward compatibility. 159 ! var_nodims(2) is the number of fields in a bundle 160 ! or 1 for unbundled fields (bundles are not yet catered for 161 ! in NEMO hence we default to 1). 154 162 INTEGER :: ji,jc,jm ! local loop indicees 155 163 CHARACTER(LEN=64) :: zclname … … 182 190 ! nl* is set to the global values 1 and jp*glo. 183 191 ! 184 ishape(:,1) = (/ 1, nlei-nldi+1 /) 185 ishape(:,2) = (/ 1, nlej-nldj+1 /) 192 ishape(1) = 1 193 ishape(2) = nlei-nldi+1 194 ishape(3) = 1 195 ishape(4) = nlej-nldj+1 196 197 186 198 ! 187 199 ! ... Allocate memory for data exchange … … 243 255 #endif 244 256 IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_Out 245 CALL oasis_def_var (ssnd(ji)%nid(jc,jm), zclname, id_part , (/ 2, 0 /), & 257 258 ! 259 ! ... Set the field dimension and bundle count 260 var_nodims(1) = 2 261 var_nodims(2) = 1 ! Modify this value to cater for bundled fields. 262 263 CALL oasis_def_var (ssnd(ji)%nid(jc,jm), zclname, id_part , var_nodims, & 246 264 & OASIS_Out , ishape , OASIS_REAL, nerror ) 247 265 IF ( nerror /= OASIS_Ok ) THEN … … 288 306 #endif 289 307 IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In 290 CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part , (/ 2, 0 /), & 308 309 ! ... Set the field dimension and bundle count 310 var_nodims(1) = 2 311 var_nodims(2) = 1 ! Modify this value to cater for bundled fields. 312 313 CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part , var_nodims, & 291 314 & OASIS_In , ishape , OASIS_REAL, nerror ) 292 315 IF ( nerror /= OASIS_Ok ) THEN -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90
r8400 r10302 167 167 168 168 #if defined key_cice 169 ALLOCATE( qla_ice(jpi,jpj,ncat) , qlw_ice(jpi,jpj,1) , qsr_ice(jpi,jpj, 1), &169 ALLOCATE( qla_ice(jpi,jpj,ncat) , qlw_ice(jpi,jpj,1) , qsr_ice(jpi,jpj,jpl) , & 170 170 wndi_ice(jpi,jpj) , tatm_ice(jpi,jpj) , qatm_ice(jpi,jpj) , & 171 171 wndj_ice(jpi,jpj) , nfrzmlt(jpi,jpj) , ss_iou(jpi,jpj) , & … … 180 180 IF( ln_cpl ) ALLOCATE( u_ice(jpi,jpj) , fr1_i0(jpi,jpj) , tn_ice (jpi,jpj,jpl) , & 181 181 & v_ice(jpi,jpj) , fr2_i0(jpi,jpj) , alb_ice(jpi,jpj,1) , & 182 & emp_ice(jpi,jpj) , qns_ice(jpi,jpj, 1), dqns_ice(jpi,jpj,1) , &182 & emp_ice(jpi,jpj) , qns_ice(jpi,jpj,jpl) , dqns_ice(jpi,jpj,1) , & 183 183 & a_p(jpi,jpj,jpl) , ht_p(jpi,jpj,jpl) , tsfc_ice(jpi,jpj,jpl) , & 184 184 & kn_ice(jpi,jpj,jpl) , STAT=ierr(2) ) -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90
r6486 r10302 19 19 USE iom ! IOM library 20 20 USE lib_mpp ! MPP library 21 USE timing 21 22 22 23 IMPLICIT NONE … … 143 144 IF( ln_rstart .AND. iom_varid( numror, 'ssh_ibb', ldstop = .FALSE. ) > 0 ) THEN 144 145 IF(lwp) WRITE(numout,*) 'sbc_apr: ssh_ibb read in the restart file' 146 IF(nn_timing == 2) CALL timing_start('iom_rstget') 145 147 CALL iom_get( numror, jpdom_autoglo, 'ssh_ibb', ssh_ibb ) ! before inv. barometer ssh 148 IF(nn_timing == 2) CALL timing_stop('iom_rstget') 146 149 ! 147 150 ELSE !* no restart: set from nit000 values … … 156 159 IF(lwp) WRITE(numout,*) 'sbc_apr : ssh_ib written in ocean restart file at it= ', kt,' date= ', ndastp 157 160 IF(lwp) WRITE(numout,*) '~~~~' 161 IF(nn_timing == 2) CALL timing_start('iom_rstput') 158 162 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ibb' , ssh_ib ) 163 IF(nn_timing == 2) CALL timing_stop('iom_rstput') 159 164 ENDIF 160 165 ! -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r8427 r10302 257 257 258 258 ! 259 IF( nn_timing == 1) CALL timing_start('sbc_cpl_init')259 IF( nn_timing.gt.0 .and. nn_timing .le. 2) CALL timing_start('sbc_cpl_init') 260 260 ! 261 261 CALL wrk_alloc( jpi,jpj, zacs, zaos ) … … 991 991 CALL wrk_dealloc( jpi,jpj, zacs, zaos ) 992 992 ! 993 IF( nn_timing == 1) CALL timing_stop('sbc_cpl_init')993 IF( nn_timing.gt.0 .and. nn_timing .le. 2 ) CALL timing_stop('sbc_cpl_init') 994 994 ! 995 995 END SUBROUTINE sbc_cpl_init … … 1062 1062 1063 1063 ! 1064 IF( nn_timing == 1) CALL timing_start('sbc_cpl_rcv')1064 IF( nn_timing.gt.0 .and. nn_timing .le. 2 ) CALL timing_start('sbc_cpl_rcv') 1065 1065 ! 1066 1066 CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 ) … … 1453 1453 CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 ) 1454 1454 ! 1455 IF( nn_timing == 1) CALL timing_stop('sbc_cpl_rcv')1455 IF( nn_timing.gt.0 .and. nn_timing .le. 2 ) CALL timing_stop('sbc_cpl_rcv') 1456 1456 ! 1457 1457 END SUBROUTINE sbc_cpl_rcv … … 1499 1499 !!---------------------------------------------------------------------- 1500 1500 ! 1501 IF( nn_timing == 1) CALL timing_start('sbc_cpl_ice_tau')1501 IF( nn_timing.gt.0 .and. nn_timing .le. 2 ) CALL timing_start('sbc_cpl_ice_tau') 1502 1502 ! 1503 1503 CALL wrk_alloc( jpi,jpj, ztx, zty ) … … 1664 1664 CALL wrk_dealloc( jpi,jpj, ztx, zty ) 1665 1665 ! 1666 IF( nn_timing == 1) CALL timing_stop('sbc_cpl_ice_tau')1666 IF( nn_timing.gt.0 .and. nn_timing .le. 2 ) CALL timing_stop('sbc_cpl_ice_tau') 1667 1667 ! 1668 1668 END SUBROUTINE sbc_cpl_ice_tau … … 1731 1731 !!---------------------------------------------------------------------- 1732 1732 ! 1733 IF( nn_timing == 1) CALL timing_start('sbc_cpl_ice_flx')1733 IF( nn_timing.gt.0 .and. nn_timing .le. 2 ) CALL timing_start('sbc_cpl_ice_flx') 1734 1734 ! 1735 1735 CALL wrk_alloc( jpi,jpj, zcptn, ztmp, zicefr, zmsk, zsnw ) … … 2116 2116 CALL wrk_dealloc( jpi,jpj,jpl, zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice ) 2117 2117 ! 2118 IF( nn_timing == 1) CALL timing_stop('sbc_cpl_ice_flx')2118 IF( nn_timing.gt.0 .and. nn_timing .le. 2 ) CALL timing_stop('sbc_cpl_ice_flx') 2119 2119 ! 2120 2120 END SUBROUTINE sbc_cpl_ice_flx … … 2141 2141 !!---------------------------------------------------------------------- 2142 2142 ! 2143 IF( nn_timing == 1) CALL timing_start('sbc_cpl_snd')2143 IF( nn_timing.gt.0 .and. nn_timing .le. 2 ) CALL timing_start('sbc_cpl_snd') 2144 2144 ! 2145 2145 CALL wrk_alloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) … … 2631 2631 CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 ) 2632 2632 ! 2633 IF( nn_timing == 1) CALL timing_stop('sbc_cpl_snd')2633 IF( nn_timing.gt.0 .and. nn_timing .le. 2 ) CALL timing_stop('sbc_cpl_snd') 2634 2634 ! 2635 2635 END SUBROUTINE sbc_cpl_snd -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
r9288 r10302 1181 1181 1182 1182 SUBROUTINE sbc_ice_cice ( kt, ksbc ) ! Dummy routine 1183 IMPLICIT NONE 1184 INTEGER, INTENT(in) :: kt ! ocean time-step index 1185 INTEGER, INTENT(in) :: ksbc ! surface forcing type 1183 1186 WRITE(*,*) 'sbc_ice_cice: You should not have seen this print! error?', kt 1184 1187 END SUBROUTINE sbc_ice_cice 1185 1188 1186 1189 SUBROUTINE cice_sbc_init (ksbc) ! Dummy routine 1190 IMPLICIT NONE 1191 INTEGER, INTENT(in) :: ksbc ! surface forcing type 1187 1192 WRITE(*,*) 'cice_sbc_init: You should not have seen this print! error?' 1188 1193 END SUBROUTINE cice_sbc_init 1189 1194 1190 1195 SUBROUTINE cice_sbc_final ! Dummy routine 1196 IMPLICIT NONE 1191 1197 WRITE(*,*) 'cice_sbc_final: You should not have seen this print! error?' 1192 1198 END SUBROUTINE cice_sbc_final -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim.F90
r6498 r10302 648 648 CONTAINS 649 649 SUBROUTINE sbc_ice_lim ( kt, kblk ) ! Dummy routine 650 IMPLICIT NONE 651 INTEGER, INTENT(in) :: kt ! ocean time step 652 INTEGER, INTENT(in) :: kblk ! type of bulk (=3 CLIO, =4 CORE, =5 COUPLED) 650 653 WRITE(*,*) 'sbc_ice_lim: You should not have seen this print! error?', kt, kblk 651 654 END SUBROUTINE sbc_ice_lim 652 655 SUBROUTINE sbc_lim_init ! Dummy routine 656 IMPLICIT NONE 653 657 END SUBROUTINE sbc_lim_init 654 658 #endif -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r8280 r10302 422 422 & iom_varid( numror, 'utau_b', ldstop = .FALSE. ) > 0 ) THEN 423 423 IF(lwp) WRITE(numout,*) ' nit000-1 surface forcing fields red in the restart file' 424 IF(nn_timing == 2) CALL timing_start('iom_rstget') 424 425 CALL iom_get( numror, jpdom_autoglo, 'utau_b', utau_b ) ! before i-stress (U-point) 425 426 CALL iom_get( numror, jpdom_autoglo, 'vtau_b', vtau_b ) ! before j-stress (V-point) … … 434 435 sfx_b (:,:) = sfx(:,:) 435 436 ENDIF 437 IF(nn_timing == 2) CALL timing_stop('iom_rstget') 436 438 ELSE !* no restart: set from nit000 values 437 439 IF(lwp) WRITE(numout,*) ' nit000-1 surface forcing fields set to nit000' … … 450 452 & 'at it= ', kt,' date= ', ndastp 451 453 IF(lwp) WRITE(numout,*) '~~~~' 454 IF(nn_timing == 2) CALL timing_start('iom_rstput') 452 455 CALL iom_rstput( kt, nitrst, numrow, 'utau_b' , utau ) 453 456 CALL iom_rstput( kt, nitrst, numrow, 'vtau_b' , vtau ) … … 457 460 CALL iom_rstput( kt, nitrst, numrow, 'emp_b' , emp ) 458 461 CALL iom_rstput( kt, nitrst, numrow, 'sfx_b' , sfx ) 462 IF(nn_timing == 2) CALL timing_stop('iom_rstput') 459 463 ENDIF 460 464 -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
r8302 r10302 27 27 USE eosbn2 28 28 USE wrk_nemo ! Memory allocation 29 USE timing 29 30 30 31 IMPLICIT NONE … … 148 149 & iom_varid( numror, 'rnf_b', ldstop = .FALSE. ) > 0 ) THEN 149 150 IF(lwp) WRITE(numout,*) ' nit000-1 runoff forcing fields red in the restart file' 151 IF(nn_timing == 2) CALL timing_start('iom_rstget') 150 152 CALL iom_get( numror, jpdom_autoglo, 'rnf_b', rnf_b ) ! before runoff 151 153 CALL iom_get( numror, jpdom_autoglo, 'rnf_hc_b', rnf_tsc_b(:,:,jp_tem) ) ! before heat content of runoff 152 154 CALL iom_get( numror, jpdom_autoglo, 'rnf_sc_b', rnf_tsc_b(:,:,jp_sal) ) ! before salinity content of runoff 155 IF(nn_timing == 2) CALL timing_stop('iom_rstget') 153 156 ELSE !* no restart: set from nit000 values 154 157 IF(lwp) WRITE(numout,*) ' nit000-1 runoff forcing fields set to nit000' … … 164 167 & 'at it= ', kt,' date= ', ndastp 165 168 IF(lwp) WRITE(numout,*) '~~~~' 169 IF(nn_timing == 2) CALL timing_start('iom_rstput') 166 170 CALL iom_rstput( kt, nitrst, numrow, 'rnf_b' , rnf ) 167 171 CALL iom_rstput( kt, nitrst, numrow, 'rnf_hc_b', rnf_tsc(:,:,jp_tem) ) 168 172 CALL iom_rstput( kt, nitrst, numrow, 'rnf_sc_b', rnf_tsc(:,:,jp_sal) ) 173 IF(nn_timing == 2) CALL timing_stop('iom_rstput') 169 174 ENDIF 170 175 ! -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90
r6486 r10302 21 21 USE prtctl ! Print control 22 22 USE iom ! IOM library 23 USE timing 23 24 24 25 IMPLICIT NONE … … 156 157 IF(lwp) WRITE(numout,*) '~~~~~~~' 157 158 zf_sbc = REAL( nn_fsbc, wp ) 159 IF(nn_timing == 2) CALL timing_start('iom_rstput') 158 160 CALL iom_rstput( kt, nitrst, numrow, 'nn_fsbc', zf_sbc ) ! sbc frequency 159 161 CALL iom_rstput( kt, nitrst, numrow, 'ssu_m' , ssu_m ) ! sea surface mean fields … … 164 166 IF( lk_vvl ) CALL iom_rstput( kt, nitrst, numrow, 'e3t_m' , e3t_m ) 165 167 CALL iom_rstput( kt, nitrst, numrow, 'frq_m' , frq_m ) 168 IF(nn_timing == 2) CALL timing_stop('iom_rstput') 166 169 ! 167 170 ENDIF … … 206 209 IF( ln_rstart .AND. iom_varid( numror, 'nn_fsbc', ldstop = .FALSE. ) > 0 ) THEN 207 210 l_ssm_mean = .TRUE. 211 IF(nn_timing == 2) CALL timing_start('iom_rstget') 208 212 CALL iom_get( numror , 'nn_fsbc', zf_sbc ) ! sbc frequency of previous run 209 213 CALL iom_get( numror, jpdom_autoglo, 'ssu_m' , ssu_m ) ! sea surface mean velocity (T-point) … … 219 223 frq_m(:,:) = 1._wp ! default definition 220 224 ENDIF 225 IF(nn_timing == 2) CALL timing_stop('iom_rstget') 221 226 ! 222 227 IF( zf_sbc /= REAL( nn_fsbc, wp ) ) THEN ! nn_fsbc has changed between 2 runs -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/STO/stopar.F90
r6487 r10302 22 22 USE iom ! I/O module 23 23 USE lib_mpp 24 24 USE timing 25 25 26 26 IMPLICIT NONE … … 697 697 ! Get stochastic parameters from restart file: 698 698 ! 2D stochastic parameters 699 IF(nn_timing == 2) CALL timing_start('iom_rstget') 699 700 DO jsto = 1 , jpsto2d 700 701 WRITE(clsto2d(7:9),'(i3.3)') jsto … … 717 718 CALL kiss_seed( ziseed(1) , ziseed(2) , ziseed(3) , ziseed(4) ) 718 719 ENDIF 720 IF(nn_timing == 2) CALL timing_stop('iom_rstget') 719 721 720 722 ! Close the restart file … … 760 762 CALL kiss_state( ziseed(1) , ziseed(2) , ziseed(3) , ziseed(4) ) 761 763 zrseed = TRANSFER( ziseed , zrseed) 764 IF(nn_timing == 2) CALL timing_start('iom_rstput') 762 765 DO jseed = 1 , 4 763 766 WRITE(clseed(5:5) ,'(i1.1)') jseed … … 775 778 CALL iom_rstput( kt, nitrst, numstow, clsto3d , sto3d(:,:,:,jsto) ) 776 779 END DO 780 IF(nn_timing == 2) CALL timing_stop('iom_rstput') 777 781 ! close the restart file 778 782 CALL iom_close( numstow ) -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90
r7179 r10302 286 286 ! avmb, avtb will be read in zdfini in restart case as they are used in zdftke, kpp etc... 287 287 IF( lrst_oce .AND. cdtype == 'TRA' ) THEN 288 IF(nn_timing == 2) CALL timing_start('iom_rstput') 288 289 CALL iom_rstput( kt, nitrst, numrow, 'avmb', avmb ) 289 290 CALL iom_rstput( kt, nitrst, numrow, 'avtb', avtb ) 291 IF(nn_timing == 2) CALL timing_stop('iom_rstput') 290 292 ENDIF 291 293 ! -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r7771 r10302 33 33 USE wrk_nemo ! Memory Allocation 34 34 USE timing ! Timing 35 USE phycst ! Physical constants 35 36 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 36 37 USE iom -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
r7771 r10302 549 549 zmbk(:,:) = REAL( mbkv_d(:,:), wp ) ; CALL lbc_lnk(zmbk,'V',1.) ; mbkv_d(:,:) = MAX( INT( zmbk(:,:) ), 1 ) 550 550 551 !* sign of grad(H) at u- and v-points 552 mgrhu(jpi,:) = 0 ; mgrhu(:,jpj) = 0 ; mgrhv(jpi,:) = 0 ; mgrhv(:,jpj) = 0 551 !! AXY (16/08/17): remove the following per George and Andrew bug-hunt 552 !! !* sign of grad(H) at u- and v-points 553 !! mgrhu(jpi,:) = 0 ; mgrhu(:,jpj) = 0 ; mgrhv(jpi,:) = 0 ; mgrhv(:,jpj) = 0 554 !! DO jj = 1, jpjm1 555 !! DO ji = 1, jpim1 556 !! mgrhu(ji,jj) = INT( SIGN( 1.e0, gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) ) ) 557 !! mgrhv(ji,jj) = INT( SIGN( 1.e0, gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) ) ) 558 !! END DO 559 !! END DO 560 561 !! AXY (16/08/17): add the following replacement per George and Andrew bug-hunt 562 !* sign of grad(H) at u- and v-points; zero if grad(H) = 0 563 mgrhu(:,:) = 0 ; mgrhv(:,:) = 0 553 564 DO jj = 1, jpjm1 554 565 DO ji = 1, jpim1 555 mgrhu(ji,jj) = INT( SIGN( 1.e0, gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) ) ) 556 mgrhv(ji,jj) = INT( SIGN( 1.e0, gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) ) ) 566 #if defined key_bbl_old_nonconserve 567 ! This key allows old (non conservative version) to be used for continuity of results 568 mgrhu(ji,jj) = INT( SIGN( 1.e0, gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) ) ) 569 mgrhv(ji,jj) = INT( SIGN( 1.e0, gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) ) ) 570 #else 571 IF( gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) /= 0._wp ) THEN 572 mgrhu(ji,jj) = INT( SIGN( 1.e0, & 573 gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) ) ) 574 ENDIF 575 ! 576 IF( gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) /= 0._wp ) THEN 577 mgrhv(ji,jj) = INT( SIGN( 1.e0, & 578 gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) ) ) 579 ENDIF 580 #endif 557 581 END DO 558 582 END DO -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
r8333 r10302 49 49 USE agrif_opa_interp 50 50 #endif 51 51 52 52 53 IMPLICIT NONE … … 340 341 DO jn = 1, kjpt 341 342 DO jk = 1, jpkm1 342 zfact = 1._wp / r2dtra(jk)343 zfact = 0.5_wp / p2dt(jk) 343 344 zfact1 = atfp * p2dt(jk) 344 345 zfact2 = zfact1 / rau0 -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
r6498 r10302 368 368 & 'at it= ', kt,' date= ', ndastp 369 369 IF(lwp) WRITE(numout,*) '~~~~' 370 IF(nn_timing == 2) CALL timing_start('iom_rstput') 370 371 CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b' , qsr_hc ) 371 372 CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev', fraqsr_1lev ) ! default definition in sbcssm 373 IF(nn_timing == 2) CALL timing_stop('iom_rstput') 372 374 ! 373 375 ENDIF … … 607 609 ! initialisation of fraqsr_1lev used in sbcssm 608 610 IF( iom_varid( numror, 'fraqsr_1lev', ldstop = .FALSE. ) > 0 ) THEN 611 IF(nn_timing == 2) CALL timing_start('iom_rstget') 609 612 CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev' , fraqsr_1lev ) 613 IF(nn_timing == 2) CALL timing_stop('iom_rstget') 610 614 ELSE 611 615 fraqsr_1lev(:,:) = 1._wp ! default definition -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
r8400 r10302 213 213 & 'at it= ', kt,' date= ', ndastp 214 214 IF(lwp) WRITE(numout,*) '~~~~' 215 IF(nn_timing == 2) CALL timing_start('iom_rstput') 215 216 CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem) ) 216 217 CALL iom_rstput( kt, nitrst, numrow, 'sbc_sc_b', sbc_tsc(:,:,jp_sal) ) 218 IF(nn_timing == 2) CALL timing_stop('iom_rstput') 217 219 ENDIF 218 220 ! … … 257 259 & 'at it= ', kt,' date= ', ndastp 258 260 IF(lwp) WRITE(numout,*) '~~~~' 261 IF(nn_timing == 2) CALL timing_start('iom_rstput') 259 262 CALL iom_rstput( kt, nitrst, numrow, 'fwf_isf_b', fwfisf(:,:) ) 260 263 CALL iom_rstput( kt, nitrst, numrow, 'isf_hc_b' , risf_tsc(:,:,jp_tem) ) 261 264 CALL iom_rstput( kt, nitrst, numrow, 'isf_sc_b' , risf_tsc(:,:,jp_sal) ) 265 IF(nn_timing == 2) CALL timing_stop('iom_rstput') 262 266 ENDIF 263 267 END IF -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/TRD/trd_oce.F90
r7179 r10302 57 57 ! 58 58 ! !!!* Passive tracers trends indices (use if "key_top" defined) 59 INTEGER, PUBLIC, PARAMETER :: jptra_sms = 19!: sources m. sinks60 INTEGER, PUBLIC, PARAMETER :: jptra_radn = 2 0!: corr. trn<0 in trcrad61 INTEGER, PUBLIC, PARAMETER :: jptra_radb = 2 1!: corr. trb<0 in trcrad (like atf)59 INTEGER, PUBLIC, PARAMETER :: jptra_sms = 21 !: sources m. sinks 60 INTEGER, PUBLIC, PARAMETER :: jptra_radn = 22 !: corr. trn<0 in trcrad 61 INTEGER, PUBLIC, PARAMETER :: jptra_radb = 23 !: corr. trb<0 in trcrad (like atf) 62 62 ! 63 63 ! !!!* Momentum trends indices -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90
r7179 r10302 195 195 CALL ken_p2k( kt , zke ) 196 196 CALL iom_put( "ketrd_convP2K", zke ) ! conversion -rau*g*w 197 # if defined key_ldfslp || key_esopa 197 198 CASE( jpdyn_eivke ) 198 199 ! CMIP6 diagnostic tknebto = tendency of KE from … … 216 217 CALL iom_put("ketrd_eiv", zke2d) 217 218 CALL wrk_dealloc( jpi, jpj, zke2d ) 219 #endif 218 220 ! 219 221 END SELECT -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_rst.F90
r6486 r10302 16 16 USE iom ! I/O module 17 17 USE restart ! only for lrst_oce 18 USE timing 18 19 19 20 IMPLICIT NONE … … 79 80 WRITE(numout,*) 80 81 ENDIF 81 82 IF(nn_timing == 2) CALL timing_start('iom_rstput') 82 83 IF( ln_trdmxl_instant ) THEN 83 84 !-- Temperature … … 115 116 CALL iom_rstput( kt, nitrst, nummxlw, 'smltrd_atf_sumb' , smltrd_atf_sumb ) 116 117 ENDIF 118 IF(nn_timing == 2) CALL timing_stop('iom_rstput') 117 119 ! 118 120 IF( kt == nitrst ) THEN … … 158 160 159 161 CALL iom_open( TRIM(clpath)//TRIM(cn_trdrst_in), inum, kiolib = jlibalt ) 160 162 IF(nn_timing == 2) CALL timing_start('iom_rstget') 161 163 IF( ln_trdmxl_instant ) THEN 162 164 !-- Temperature … … 194 196 CALL iom_get( inum, jpdom_autoglo, 'smltrd_atf_sumb' , smltrd_atf_sumb) 195 197 ! 196 CALL iom_close( inum ) 197 ENDIF 198 ENDIF 199 IF(nn_timing == 2) CALL timing_stop('iom_rstget') 200 CALL iom_close( inum ) 198 201 ! 199 202 END SUBROUTINE trd_mxl_rst_read -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90
r8104 r10302 20 20 USE trd_oce ! trends: ocean variables 21 21 USE trdtrc ! ocean passive mixed layer tracers trends 22 # if defined key_top 23 USE trc, ONLY: tra ! tracer definitions (trn, trb, tra, etc.) 24 # endif 22 25 USE trdglo ! trends: global domain averaged 23 26 USE trdpen ! trends: Potential ENergy … … 163 166 ENDIF 164 167 168 # if defined key_top 165 169 IF( ctype == 'TRC' ) THEN !== passive tracer trend ==! 166 170 ! … … 170 174 CASE( jptra_yad ) ; CALL trd_tra_adv( ptrd , pun , ptra, 'Y', ztrds ) 171 175 CASE( jptra_zad ) ; CALL trd_tra_adv( ptrd , pun , ptra, 'Z', ztrds ) 176 CASE( jptra_zdfp ) ! diagnose the "PURE" Kz trend (here: just before the swap) 177 ! ! iso-neutral diffusion case otherwise 178 ! jptra_zdf is "PURE" 179 CALL wrk_alloc( jpi, jpj, jpk, zws ) 180 ! 181 zws(:,:, 1 ) = 0._wp ! vertical diffusive fluxes 182 zws(:,:,jpk) = 0._wp 183 DO jk = 2, jpk 184 zws(:,:,jk) = avt(:,:,jk) * (tra(:,:,jk-1,ktra) - tra(:,:,jk,ktra) ) / fse3w(:,:,jk) * tmask(:,:,jk) 185 END DO 186 ! 187 ztrds(:,:,jpk) = 0._wp 188 DO jk = 1, jpkm1 189 ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / fse3t(:,:,jk) 190 END DO 191 CALL wrk_dealloc( jpi, jpj, jpk, zws ) 192 ! 172 193 CASE DEFAULT ! other trends: just masked 173 194 ztrds(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) … … 177 198 ! 178 199 ENDIF 200 # endif 179 201 ! 180 202 CALL wrk_dealloc( jpi, jpj, jpk, ztrds ) -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
r6487 r10302 1184 1184 ! 1185 1185 IF( MIN( id1, id2, id3, id4, id5, id6 ) > 0 ) THEN ! all required arrays exist 1186 IF(nn_timing == 2) CALL timing_start('iom_rstget') 1186 1187 CALL iom_get( numror, jpdom_autoglo, 'en' , en ) 1187 1188 CALL iom_get( numror, jpdom_autoglo, 'avt' , avt ) … … 1190 1191 CALL iom_get( numror, jpdom_autoglo, 'avmv' , avmv ) 1191 1192 CALL iom_get( numror, jpdom_autoglo, 'mxln' , mxln ) 1193 IF(nn_timing == 2) CALL timing_stop('iom_rstget') 1192 1194 ELSE 1193 1195 IF(lwp) WRITE(numout,*) ' ===>>>> : previous run without gls scheme, en and mxln computed by iterative loop' … … 1209 1211 ! ! ------------------- 1210 1212 IF(lwp) WRITE(numout,*) '---- gls-rst ----' 1213 IF(nn_timing == 2) CALL timing_start('iom_rstput') 1211 1214 CALL iom_rstput( kt, nitrst, numrow, 'en' , en ) 1212 1215 CALL iom_rstput( kt, nitrst, numrow, 'avt' , avt_k ) … … 1215 1218 CALL iom_rstput( kt, nitrst, numrow, 'avmv' , avmv_k ) 1216 1219 CALL iom_rstput( kt, nitrst, numrow, 'mxln' , mxln ) 1220 IF(nn_timing == 2) CALL timing_stop('iom_rstput') 1217 1221 ! 1218 1222 ENDIF … … 1227 1231 CONTAINS 1228 1232 SUBROUTINE zdf_gls_init ! Empty routine 1233 IMPLICIT NONE 1229 1234 WRITE(*,*) 'zdf_gls_init: You should not have seen this print! error?' 1230 1235 END SUBROUTINE zdf_gls_init 1236 1231 1237 SUBROUTINE zdf_gls( kt ) ! Empty routine 1238 IMPLICIT NONE 1239 INTEGER, INTENT(in) :: kt ! ocean time step 1232 1240 WRITE(*,*) 'zdf_gls: You should not have seen this print! error?', kt 1233 1241 END SUBROUTINE zdf_gls 1242 1234 1243 SUBROUTINE gls_rst( kt, cdrw ) ! Empty routine 1244 IMPLICIT NONE 1235 1245 INTEGER , INTENT(in) :: kt ! ocean time-step 1236 1246 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90
r6486 r10302 1576 1576 CONTAINS 1577 1577 SUBROUTINE zdf_kpp_init ! Dummy routine 1578 IMPLICIT NONE 1578 1579 WRITE(*,*) 'zdf_kpp_init: You should not have seen this print! error?' 1579 1580 END SUBROUTINE zdf_kpp_init 1580 1581 SUBROUTINE zdf_kpp( kt ) ! Dummy routine 1582 IMPLICIT NONE 1583 INTEGER, INTENT( in ) :: kt ! ocean time step 1581 1584 WRITE(*,*) 'zdf_kpp: You should not have seen this print! error?', kt 1582 1585 END SUBROUTINE zdf_kpp 1583 1586 SUBROUTINE tra_kpp( kt ) ! Dummy routine 1587 IMPLICIT NONE 1588 INTEGER, INTENT( in ) :: kt ! ocean time step 1584 1589 WRITE(*,*) 'tra_kpp: You should not have seen this print! error?', kt 1585 1590 END SUBROUTINE tra_kpp 1586 1591 SUBROUTINE trc_kpp( kt ) ! Dummy routine 1592 IMPLICIT NONE 1593 INTEGER, INTENT( in ) :: kt ! ocean time step 1587 1594 WRITE(*,*) 'trc_kpp: You should not have seen this print! error?', kt 1588 1595 END SUBROUTINE trc_kpp -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90
r6486 r10302 307 307 CONTAINS 308 308 SUBROUTINE zdf_ric_init ! Dummy routine 309 IMPLICIT NONE 309 310 END SUBROUTINE zdf_ric_init 310 311 SUBROUTINE zdf_ric( kt ) ! Dummy routine 312 IMPLICIT NONE 313 INTEGER, INTENT( in ) :: kt ! ocean time-step 311 314 WRITE(*,*) 'zdf_ric: You should not have seen this print! error?', kt 312 315 END SUBROUTINE zdf_ric -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r6498 r10302 937 937 CALL iom_get( numror, jpdom_autoglo, 'en', en ) 938 938 IF( MIN( id2, id3, id4, id5, id6 ) > 0 ) THEN ! all required arrays exist 939 IF(nn_timing == 2) CALL timing_start('iom_rstget') 939 940 CALL iom_get( numror, jpdom_autoglo, 'avt' , avt ) 940 941 CALL iom_get( numror, jpdom_autoglo, 'avm' , avm ) … … 942 943 CALL iom_get( numror, jpdom_autoglo, 'avmv' , avmv ) 943 944 CALL iom_get( numror, jpdom_autoglo, 'dissl', dissl ) 945 IF(nn_timing == 2) CALL timing_stop('iom_rstget') 944 946 ELSE ! one at least array is missing 945 947 CALL tke_avn ! compute avt, avm, avmu, avmv and dissl (approximation) … … 970 972 ! ! ------------------- 971 973 IF(lwp) WRITE(numout,*) '---- tke-rst ----' 974 IF(nn_timing == 2) CALL timing_start('iom_rstput') 972 975 CALL iom_rstput( kt, nitrst, numrow, 'en' , en ) 973 976 CALL iom_rstput( kt, nitrst, numrow, 'avt' , avt_k ) … … 976 979 CALL iom_rstput( kt, nitrst, numrow, 'avmv' , avmv_k ) 977 980 CALL iom_rstput( kt, nitrst, numrow, 'dissl', dissl ) 981 IF(nn_timing == 2) CALL timing_stop('iom_rstput') 978 982 ! 979 983 ENDIF -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90
r7179 r10302 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/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r10301 r10302 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) … … 160 161 IF( ln_dyninc ) CALL dyn_asm_inc( nit000 - 1 ) ! Dynamics 161 162 IF( ln_sshinc ) CALL ssh_asm_inc( nit000 - 1 ) ! SSH 163 IF( lk_bgcinc ) CALL bgc_asm_inc( nit000 - 1 ) ! BGC 162 164 ENDIF 163 165 ENDIF … … 192 194 IF( lk_diaobs ) CALL dia_obs_wri 193 195 ! 196 IF( ( lk_asminc ).AND.( ln_balwri ) ) CALL asm_bgc_bal_wri( nitend ) ! Output balancing increments 197 ! 194 198 IF( ln_icebergs ) CALL icb_end( nitend ) 195 199 … … 208 212 CALL Agrif_ParentGrid_To_ChildGrid() 209 213 IF( lk_diaobs ) CALL dia_obs_wri 210 IF( nn_timing == 1) CALL timing_finalize214 IF( nn_timing > 0 ) CALL timing_finalize 211 215 CALL Agrif_ChildGrid_To_ParentGrid() 212 216 ENDIF 213 217 #endif 214 IF( nn_timing == 1) CALL timing_finalize218 IF( nn_timing > 0 ) CALL timing_finalize 215 219 ! 216 220 CALL nemo_closefile … … 405 409 ENDIF 406 410 ! 407 IF( nn_timing == 1) CALL timing_init411 IF( nn_timing > 0 ) CALL timing_init 408 412 ! 409 413 ! ! General initialization -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/oce.F90
r8280 r10302 101 101 INTEGER :: ierr(5) 102 102 !!---------------------------------------------------------------------- 103 ierr(:) = 0 103 104 ! 104 105 ALLOCATE( ub (jpi,jpj,jpk) , un (jpi,jpj,jpk) , ua(jpi,jpj,jpk) , & -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/step.F90
r9288 r10302 253 253 ! Passive Tracer Model 254 254 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 255 IF( lk_asminc .AND. ln_asmiau .AND. lk_bgcinc ) & 256 & CALL bgc_asm_inc( kstp ) ! biogeochemistry assimilation 255 257 CALL trc_stp( kstp ) ! time-stepping 256 258 #endif -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/OPA_SRC/stpctl.F90
r6487 r10302 58 58 INTEGER :: ii, ij, ik ! temporary integers 59 59 REAL(wp) :: zumax, zsmin, zssh2 ! temporary scalars 60 REAL(wp) :: ztmax, ztmin ! Scalar to get temperature extreme 61 ! values and warn if they're out of Range 60 62 INTEGER, DIMENSION(3) :: ilocu ! 61 63 INTEGER, DIMENSION(2) :: ilocs ! … … 148 150 9500 FORMAT (' kt=',i6,' min SSS: ',1pg11.4,', i j: ',2i5) 149 151 152 ! ==================================================================================================== 153 ! ==================================================================================================== 154 ! !AXY (25/10/17) 155 ! !* Test max/min limits of temperature 156 ! ! ---------------------------------- 157 ztmax = -5.e0 ! arbitrary low maximum value 158 ztmin = 100.e0 ! arbitrary high minimum value 159 DO jj = 2, jpjm1 160 DO ji = 2, jpim1 161 IF( tmask(ji,jj,1) == 1) THEN 162 ztmax = MAX(ztmax,tsn(ji,jj,1,jp_tem)) ! find local maximum 163 ztmin = MIN(ztmin,tsn(ji,jj,1,jp_tem)) ! find local minimum 164 ENDIF 165 END DO 166 END DO 167 IF( lk_mpp ) CALL mpp_max( ztmax ) ! max over the global domain 168 IF( lk_mpp ) CALL mpp_min( ztmin ) ! min over the global domain 169 ! 170 IF( ztmax > 40.) THEN ! we've got a problem 171 IF (lk_mpp) THEN 172 CALL mpp_maxloc ( tsn(:,:,1,jp_tem),tmask(:,:,1), ztmax, ii,ij ) 173 ELSE 174 ilocs = MAXLOC( tsn(:,:,1,jp_tem), mask = tmask(:,:,1) == 1.e0 ) 175 ii = ilocs(1) + nimpp - 1 176 ij = ilocs(2) + njmpp - 1 177 ENDIF 178 ! 179 IF(lwp) THEN 180 WRITE(numout,*) 'stp_ctl:tracer anomaly: ***** WARNING *****' 181 WRITE(numout,*) 'stp_ctl:tracer anomaly: sea surface temperature > 40C' 182 WRITE(numout,9600) kt, ztmax, ii, ij 183 WRITE(numout,*) 'stp_ctl:tracer anomaly: ***** END OF WARNING *****' 184 ENDIF 185 ENDIF 186 ! 187 IF( ztmin < -10.) THEN ! we've got a problem 188 IF (lk_mpp) THEN 189 CALL mpp_minloc ( tsn(:,:,1,jp_tem),tmask(:,:,1), ztmin, ii,ij ) 190 ELSE 191 ilocs = MINLOC( tsn(:,:,1,jp_tem), mask = tmask(:,:,1) == 1.e0 ) 192 ii = ilocs(1) + nimpp - 1 193 ij = ilocs(2) + njmpp - 1 194 ENDIF 195 ! 196 IF(lwp) THEN 197 WRITE(numout,*) 'stp_ctl:tracer anomaly: ***** WARNING *****' 198 WRITE(numout,*) 'stp_ctl:tracer anomaly: sea surface temperature < -10C' 199 WRITE(numout,9700) kt, ztmin, ii, ij 200 WRITE(numout,*) 'stp_ctl:tracer anomaly: ***** END OF WARNING *****' 201 ENDIF 202 ENDIF 203 9600 FORMAT ('stp_ctl:tracer anomaly: kt=',i6,' max SST: ',f16.10,', i j: ',2i5) 204 9700 FORMAT ('stp_ctl:tracer anomaly: kt=',i6,' min SST: ',f16.10,', i j: ',2i5) 205 ! ==================================================================================================== 206 ! ==================================================================================================== 150 207 151 208 IF( lk_c1d ) RETURN ! No log file in case of 1D vertical configuration -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90
r6486 r10302 330 330 CONTAINS 331 331 SUBROUTINE trc_sms_c14b( kt ) ! Empty routine 332 IMPLICIT NONE 333 INTEGER, INTENT(in) :: kt ! ocean time-step index 332 334 WRITE(*,*) 'trc_freons: You should not have seen this print! error?', kt 333 335 END SUBROUTINE trc_sms_c14b -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/CFC/trcini_cfc.F90
r8280 r10302 44 44 !! ** Method : - Read the namcfc namelist and check the parameter values 45 45 !!---------------------------------------------------------------------- 46 INTEGER :: ji, jj, jn, jl, jm, js, io, i err46 INTEGER :: ji, jj, jn, jl, jm, js, io, iostatus, ierr 47 47 INTEGER :: iskip = 7 ! number of 1st descriptor lines 48 48 REAL(wp) :: zyy, zyd … … 57 57 58 58 CALL ctl_opn( inum, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 59 REWIND(inum)60 59 61 60 ! compute the number of year in the file 62 61 ! file starts in 1931 do jn represent the year in the century 62 iostatus = 0 63 63 jn = 31 64 DO 65 READ(inum,'(1x)', END=100)64 DO WHILE ( iostatus == 0 ) 65 READ(inum,'(1x)', IOSTAT=iostatus, END=100) 66 66 jn = jn + 1 67 END DO 67 ENDDO 68 IF( iostatus .NE. 0 ) THEN 69 !! Error while reading CFC input file 70 CALL ctl_stop('trc_ini_cfc: & 71 & Error on the 1st reading of cfc1112sf6.atm') 72 RETURN 73 ENDIF 68 74 100 jpyear = jn - 1 - iskip 69 75 IF ( lwp) WRITE(numout,*) ' ', jpyear ,' years read' … … 72 78 ALLOCATE( p_cfc(jpyear,jphem,3), STAT=ierr ) 73 79 IF( ierr > 0 ) THEN 74 CALL ctl_stop( 'trc_ini_cfc: unable to allocate p_cfc array' ) ; RETURN 80 CALL ctl_stop( 'trc_ini_cfc: unable to allocate p_cfc array' ) 81 RETURN 75 82 ENDIF 76 83 IF( trc_sms_cfc_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'trc_ini_cfc: unable to allocate CFC arrays' ) … … 101 108 ! file starts in 1931 do jn represent the year in the century.jhh 102 109 ! Read file till the end 103 jn = 31104 DO110 DO jn = 31, jpyear 111 !!READ(inum, '(F6.1,6F7.2)', IOSTAT=io) zyy, p_cfc(jn,1,1), p_cfc(jn,1,2), & 105 112 READ(inum,*, IOSTAT=io) zyy, p_cfc(jn,1,1), p_cfc(jn,1,2), & 106 113 & p_cfc(jn,1,3), p_cfc(jn,2,1), & 107 114 & p_cfc(jn,2,2), p_cfc(jn,2,3) 108 IF( io < 0 ) exit 109 jn = jn + 1 115 IF( io .NE.0 ) THEN 116 !! Error while reading CFC input file 117 CALL ctl_stop('trc_ini_cfc: & 118 & Error on the 2nd reading of cfc1112sf6.atm') 119 RETURN 120 ENDIF 110 121 END DO 111 122 -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90
r8442 r10302 24 24 USE trdtrc 25 25 USE iom ! I/O library 26 USE wrk_nemo 26 27 27 28 IMPLICIT NONE … … 54 55 REAL(wp) :: xconv3 = 1.0e+3 ! conversion from mol/l/atm to mol/m3/atm 55 56 REAL(wp) :: xconv4 = 1.0e-12 ! conversion from mol/m3/atm to mol/m3/pptv 57 58 !! trend temporary array: 59 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcfc 56 60 57 61 !! * Substitutions … … 265 269 ! 266 270 IF( l_trdtrc ) THEN 271 CALL wrk_alloc( jpi, jpj, jpk, ztrcfc ) 267 272 DO jn = jp_cfc0, jp_cfc1 268 CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt ) ! save trends 273 ztrcfc(:,:,:) = tra(:,:,:,jn) 274 CALL trd_trc( ztrcfc, jn, jptra_sms, kt ) ! save trends 269 275 END DO 276 CALL wrk_dealloc( jpi, jpj, jpk, ztrcfc ) 270 277 END IF 271 278 ! -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/MEDUSA/air_sea.F90
r8442 r10302 6 6 !! History : 7 7 !! - ! 2017-04 (M. Stringer) Code taken from trcbio_medusa.F90 8 !! - ! 2017-08 (A. Yool) Add air-sea flux kill switch 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_medusa … … 61 62 # endif 62 63 zchd, zchn, zdin, zsil 63 USE dom_oce, ONLY: e3t_0, e3t_n, gphit, tmask 64 # if defined key_iomput 64 USE dom_oce, ONLY: e3t_0, gphit, tmask, mig, mjg 65 # if defined key_vvl 66 USE dom_oce, ONLY: e3t_n 67 # endif 65 68 USE iom, ONLY: lk_iomput 66 # endif67 69 USE in_out_manager, ONLY: lwp, numout 68 USE oce, ONLY: PCO2a_in_cpl69 70 USE par_kind, ONLY: wp 70 71 USE par_oce, ONLY: jpi, jpim1, jpj, jpjm1 71 USE sbc_oce, ONLY: fr_i, lk_oasis,qsr, wndm72 USE sbc_oce, ONLY: fr_i, qsr, wndm 72 73 USE sms_medusa, ONLY: jdms, jdms_input, jdms_model, & 73 74 jriver_alk, jriver_c, & 74 75 jriver_n, jriver_si, & 76 ln_foam_medusa, & 75 77 riv_alk, riv_c, riv_n, riv_si, & 76 78 zn_dms_chd, zn_dms_chn, zn_dms_din, & 77 79 zn_dms_mld, zn_dms_qsr, & 80 f2_pco2w, f2_fco2w, & 78 81 xnln, xnld 79 82 USE trc, ONLY: med_diag … … 86 89 # else 87 90 USE trcco2_medusa, ONLY: trc_co2_medusa 91 USE mocsy_mainmod, ONLY: p2fCO2 88 92 # endif 89 93 USE trcdms_medusa, ONLY: trc_dms_medusa 90 94 USE trcoxy_medusa, ONLY: trc_oxy_medusa 91 95 # endif 96 USE lib_mpp, ONLY: ctl_stop 97 USE trcstat, ONLY: trc_rst_dia_stat 92 98 93 99 !!* Substitution … … 121 127 122 128 # if defined key_roam 129 !! init 130 f_fco2w(:,:) = 0.0 131 f_fco2atm(:,:) = 0.0 132 f_schmidtco2(:,:) = 0.0 133 f_kwco2(:,:) = 0.0 134 f_co2starair(:,:) = 0.0 135 f_dpco2(:,:) = 0.0 136 f_rhosw(:,:) = 0.0 137 f_K0(:,:) = 0.0 138 !! air pressure (atm); ultimately this will use air 139 !! pressure at the base of the UKESM1 atmosphere 140 !! 141 f_pp0(:,:) = 1.0 142 143 123 144 !!----------------------------------------------------------- 124 145 !! Air-sea gas exchange … … 133 154 DO ji = 2,jpim1 134 155 !! OPEN wet point IF..THEN loop 135 if (tmask(ji,jj,1) == 1) then 136 IF (lk_oasis) THEN 137 !! use 2D atm xCO2 from atm coupling 138 f_xco2a(ji,jj) = PCO2a_in_cpl(ji,jj) 139 ENDIF 156 IF (tmask(ji,jj,1) == 1) then 140 157 !! 141 158 !! AXY (23/06/15): as part of an effort to update the … … 161 178 'air-sea: carb-chem kt = ', kt 162 179 CALL flush(numout) 180 !! JPALM add carb print: 181 call trc_rst_dia_stat(f_xco2a(:,:), 'f_xco2a') 182 call trc_rst_dia_stat(wndm(:,:), 'wndm') 183 call trc_rst_dia_stat(f_kw660(:,:), 'f_kw660') 184 call trc_rst_dia_stat(ztmp(:,:), 'ztmp') 185 call trc_rst_dia_stat(zsal(:,:), 'zsal') 186 call trc_rst_dia_stat(zalk(:,:), 'zalk') 187 call trc_rst_dia_stat(zdic(:,:), 'zdic') 188 call trc_rst_dia_stat(zsil(:,:), 'zsil') 189 call trc_rst_dia_stat(zpho(:,:), 'zpho') 163 190 # endif 191 # if defined key_axy_carbchem 192 # if defined key_mocsy 164 193 DO jj = 2,jpjm1 165 194 DO ji = 2,jpim1 166 195 if (tmask(ji,jj,1) == 1) then 167 !! air pressure (atm); ultimately this will use air 168 !! pressure at the base of the UKESM1 atmosphere 169 !! 170 f_pp0(ji,jj) = 1.0 171 !! 172 !! IF(lwp) WRITE(numout,*) ' MEDUSA ztmp =', ztmp(ji,jj) 173 !! IF(lwp) WRITE(numout,*) ' MEDUSA wndm =', wndm(ji,jj) 174 !! IF(lwp) WRITE(numout,*) ' MEDUSA fr_i =', fr_i(ji,jj) 175 !! 176 # if defined key_axy_carbchem 177 # if defined key_mocsy 196 !! 197 !! Jpalm -- 12-09-2017 -- add extra check after reccurent 198 !! carbonate failure in the coupled run. 199 !! must be associated to air-sea flux or air xCO2... 200 !! Check MOCSY inputs 201 IF ( (zsal(ji,jj) > 75.0 ).OR.(zsal(ji,jj) < 0.0 ) .OR. & 202 (ztmp(ji,jj) > 50.0 ).OR.(ztmp(ji,jj) < -20.0 ) .OR. & 203 (zalk(ji,jj) > 35.0E2 ).OR.(zalk(ji,jj) <= 0.0 ) .OR. & 204 (zdic(ji,jj) > 35.0E2 ).OR.(zdic(ji,jj) <= 0.0 ) .OR. & 205 (f_kw660(ji,jj) > 1.0E-2 ).OR.(f_kw660(ji,jj) < 0.0 ) ) THEN 206 IF(lwp) THEN 207 WRITE(numout,*) ' surface T = ',ztmp(ji,jj) 208 WRITE(numout,*) ' surface S = ',zsal(ji,jj) 209 WRITE(numout,*) ' surface ALK = ',zalk(ji,jj) 210 WRITE(numout,*) ' surface DIC = ',zdic(ji,jj) 211 WRITE(numout,*) ' KW660 = ',f_kw660(ji,jj) 212 WRITE(numout,*) ' atm xCO2 = ',f_xco2a(ji,jj) 213 WRITE(numout,*) ' surface pco2w = ',f_pco2w(ji,jj) 214 WRITE(numout,*) ' surface fco2w = ',f_fco2w(ji,jj) 215 WRITE(numout,*) ' surface fco2a = ',f_fco2atm(ji,jj) 216 WRITE(numout,*) ' surface co2flx = ',f_co2flux(ji,jj) 217 WRITE(numout,*) ' surface dpco2 = ',f_dpco2(ji,jj) 218 WRITE(numout,*) ' MOCSY input: ji =', mig(ji),' jj = ', mjg(jj), & 219 ' kt = ', kt 220 WRITE(numout,*) 'MEDUSA - Air-Sea INPUT: unrealistic surface Carb. Chemistry' 221 ENDIF 222 CALL ctl_stop( 'MEDUSA - Air-Sea INPUT: ', & 223 'unrealistic surface Carb. Chemistry -- INPUTS' ) 224 ENDIF 178 225 !! 179 226 !! AXY (22/06/15): use Orr & Epitalon (2015) MOCSY-2 carbonate … … 200 247 f_TALK(ji,jj) = (zalk(ji,jj) / f_rhosw(ji,jj)) * 1000. 201 248 f_dcf(ji,jj) = f_rhosw(ji,jj) 249 !! Jpalm -- 12-09-2017 -- add extra check after reccurent 250 !! carbonate failure in the coupled run. 251 !! must be associated to air-sea flux or air xCO2... 252 !! Check MOCSY outputs 253 !!=================== 254 !! Jpalm -- 19-02-2018 -- remove the cap - only check MOCSY inputs 255 !! because of specific area in arabic sea where strangely 256 !! with core 2 forcing, ALK is lower than DIC and result in 257 !! Enormous dpco2 - even if all carb chem caract are OK. 258 !! and this check stops the model. 259 !! --Input checks are already more than enough to stop the 260 !! model if carb chem goes crazy. 261 !! we remove the mocsy output checks 262 !!=================== 263 !!IF ( (f_pco2w(ji,jj) > 1.E4 ).OR.(f_pco2w(ji,jj) < 0.0 ) .OR. & 264 !! (f_fco2w(ji,jj) > 1.E4 ).OR.(f_fco2w(ji,jj) < 0.0 ) .OR. & 265 !! (f_fco2atm(ji,jj) > 1.E4 ).OR.(f_fco2atm(ji,jj) < 0.0 ) .OR. & 266 !! (f_co2flux(ji,jj) > 1.E-1 ).OR.(f_co2flux(ji,jj) < -1.E-1 ) .OR. & 267 !! (f_dpco2(ji,jj) > 1.E4 ).OR.(f_dpco2(ji,jj) < -1.E4 ) ) THEN 268 !! IF(lwp) THEN 269 !! WRITE(numout,*) ' surface T = ',ztmp(ji,jj) 270 !! WRITE(numout,*) ' surface S = ',zsal(ji,jj) 271 !! WRITE(numout,*) ' surface ALK = ',zalk(ji,jj) 272 !! WRITE(numout,*) ' surface DIC = ',zdic(ji,jj) 273 !! WRITE(numout,*) ' KW660 = ',f_kw660(ji,jj) 274 !! WRITE(numout,*) ' atm xCO2 = ',f_xco2a(ji,jj) 275 !! WRITE(numout,*) ' surface pco2w = ',f_pco2w(ji,jj) 276 !! WRITE(numout,*) ' surface fco2w = ',f_fco2w(ji,jj) 277 !! WRITE(numout,*) ' surface fco2a = ',f_fco2atm(ji,jj) 278 !! WRITE(numout,*) ' surface co2flx = ',f_co2flux(ji,jj) 279 !! WRITE(numout,*) ' surface dpco2 = ',f_dpco2(ji,jj) 280 !! WRITE(numout,*) ' MOCSY output: ji =', mig(ji),' jj = ', mjg(jj), & 281 !! ' kt = ', kt 282 !! WRITE(numout,*) 'MEDUSA - Air-Sea OUTPUT: unrealistic surface Carb. Chemistry' 283 !! ENDIF 284 !! CALL ctl_stop( 'MEDUSA - Air-Sea OUTPUT: ', & 285 !! 'unrealistic surface Carb. Chemistry -- OUTPUTS' ) 286 !!ENDIF 202 287 ENDIF 203 288 ENDDO 204 289 ENDDO 205 290 291 # if defined key_debug_medusa 292 !! JPALM add carb print: 293 call trc_rst_dia_stat(f_pco2w(:,:), 'f_pco2w') 294 call trc_rst_dia_stat(f_fco2w(:,:), 'f_fco2w') 295 call trc_rst_dia_stat(f_fco2atm(:,:), 'f_fco2atm') 296 call trc_rst_dia_stat(f_schmidtco2(:,:), 'f_schmidtco2') 297 call trc_rst_dia_stat(f_kwco2(:,:), 'f_kwco2') 298 call trc_rst_dia_stat(f_co2starair(:,:), 'f_co2starair') 299 call trc_rst_dia_stat(f_co2flux(:,:), 'f_co2flux') 300 call trc_rst_dia_stat(f_dpco2(:,:), 'f_dpco2') 301 # endif 206 302 # else 207 303 … … 234 330 iters, ' AT (', ji, ', ', jj, ', 1) AT ', kt 235 331 endif 332 IF ( ln_foam_medusa ) THEN 333 !! DAF (Aug 2017): calculate fCO2 for observation operator 334 CALL p2fCO2( f_pco2w, ztmp, f_pp0, 0.0, 1, f_fco2w ) 335 ENDIF 236 336 ENDIF 237 337 ENDDO … … 277 377 ENDDO 278 378 ENDDO 379 # endif 380 381 # if defined key_axy_killco2flux 382 !! AXY (18/08/17): single kill switch on air-sea CO2 flux for budget checking 383 f_co2flux(:,:) = 0. 279 384 # endif 280 385 … … 408 513 CO2flux_conv 409 514 !! ENDIF 515 IF ( ln_foam_medusa ) THEN 516 !! DAF (Aug 2017): Save pCO2 and fCO2 for observation operator 517 f2_pco2w(ji,jj) = f_pco2w(ji,jj) 518 f2_fco2w(ji,jj) = f_pco2w(ji,jj) 519 ENDIF 410 520 IF ( lk_iomput ) THEN 411 521 IF( med_diag%ATM_PCO2%dgsave ) THEN -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_med_diag_iomput.F90
r8442 r10302 31 31 !!------------------------------------------------------------------- 32 32 USE bio_medusa_mod 33 USE dom_oce, ONLY: e3t_0, e3t_n, mbathy, tmask 33 USE dom_oce, ONLY: e3t_0, mbathy, tmask 34 # if defined key_vvl 35 USE dom_oce, ONLY: e3t_n 36 # endif 34 37 USE in_out_manager, ONLY: lwp, numout 35 38 USE par_oce, ONLY: jpim1, jpjm1 … … 718 721 CONTAINS 719 722 SUBROUTINE bio_med_diag_iomput( ) ! Empty routine 723 IMPLICIT NONE 720 724 WRITE(*,*) 'bio_med_diag_iomput: You should not have seen this print! error?' 721 725 END SUBROUTINE bio_med_diag_iomput -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_medusa_diag.F90
r8442 r10302 32 32 USE bio_med_diag_iomput_mod, ONLY: bio_med_diag_iomput 33 33 USE bio_medusa_mod 34 USE dom_oce, ONLY: e3t_0, e3t_n, & 35 gdepw_0, gdepw_n, tmask 34 USE dom_oce, ONLY: e3t_0, gdepw_0, tmask 35 # if defined key_vvl 36 USE dom_oce, ONLY: e3t_n, gdepw_n 37 # endif 36 38 USE in_out_manager, ONLY: lwp, numout 37 # if defined key_iomput38 39 USE iom, ONLY: lk_iomput 39 # endif40 40 USE par_oce, ONLY: jpim1, jpjm1 41 41 USE sms_medusa, ONLY: xrfn, xthetapd, xthetapn, & -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_medusa_diag_slice.F90
r8442 r10302 35 35 USE dom_oce, ONLY: tmask 36 36 USE in_out_manager, ONLY: lwp, numout 37 # if defined key_iomput38 37 USE iom, ONLY: iom_put 39 # endif40 38 USE lbclnk, ONLY: lbc_lnk 41 USE trc, ONLY: trn 42 USE oce, ONLY: CO2Flux_out_cpl, DMS_out_cpl, chloro_out_cpl 39 USE oce, ONLY: CO2Flux_out_cpl, DMS_out_cpl 43 40 USE par_oce, ONLY: jpi, jpj 44 41 USE sbc_oce, ONLY: lk_oasis, qsr, wndm … … 48 45 jdms, ocal_ccd, xpar, xze, & 49 46 zb_co2_flx, zb_dms_srf, & 50 zn_co2_flx, zn_dms_srf , zn_chl_srf47 zn_co2_flx, zn_dms_srf 51 48 USE trc, ONLY: med_diag 52 49 … … 66 63 !! 67 64 IF (jk.eq.1) THEN 68 !! JPALM -- 02-06-2017 --69 !! add Chl surf coupling70 !! no need to output, just pass to cpl var71 IF (lk_oasis) THEN72 zn_chl_srf(:,:) = (trn(:,:,1,jpchd) + trn(:,:,1,jpchn)) * 1.0E-6 !! surf Chl in Kg-chl/m3 as needed for cpl73 chloro_out_cpl(:,:) = zn_chl_srf(:,:) !! Coupling Chl74 END IF75 65 IF( med_diag%MED_QSR%dgsave ) THEN 76 66 CALL iom_put( "MED_QSR" , qsr ) ! -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_medusa_fin.F90
r8442 r10302 6 6 !! History : 7 7 !! - ! 2017-04 (M. Stringer) Code taken from trcbio_medusa.F90 8 !! - ! 2017-08 (A. Yool) Amend bethic reservoir updating 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_medusa … … 32 33 !!---------------------------------------------------------------------- 33 34 USE bio_medusa_mod 34 USE dom_oce, ONLY: atfp, atfp1, neuler, rdt, e3t_n,tmask35 USE dom_oce, ONLY: atfp, atfp1, neuler, rdt, tmask 35 36 USE in_out_manager, ONLY: lwp, numout 36 # if defined key_iomput 37 USE iom, ONLY: iom_put, lk_iomput 38 # endif 37 USE iom, ONLY: iom_put 39 38 USE lbclnk, ONLY: lbc_lnk 39 USE oce, ONLY: chloro_out_cpl 40 40 USE par_medusa, ONLY: jp_medusa_2d, jp_medusa_3d, & 41 jp_medusa_trd 41 jp_medusa_trd, jpchd, jpchn 42 42 USE par_oce, ONLY: jpi, jpim1, jpj, jpjm1, jpk 43 43 USE phycst, ONLY: rsmall 44 USE sbc_oce, ONLY: lk_oasis 44 45 USE sms_medusa, ONLY: jinorgben, jorgben, & 45 46 f3_co3, f3_h2co3, f3_hco3, & 46 47 f3_omarg, f3_omcal, f3_pH, & 48 ln_foam_medusa, mld_max, pgrow_avg, & 49 ploss_avg, phyt_avg, & 47 50 za_sed_c, za_sed_ca, za_sed_fe, & 48 51 za_sed_n, za_sed_si, & … … 50 53 zb_sed_n, zb_sed_si, & 51 54 zn_sed_c, zn_sed_ca, zn_sed_fe, & 52 zn_sed_n, zn_sed_si 53 USE trc, ONLY: med_diag, nittrc000 55 zn_sed_n, zn_sed_si, zn_chl_srf, & 56 scl_chl, chl_out 57 USE trc, ONLY: med_diag, nittrc000, trn 54 58 USE trcnam_trp, ONLY: ln_trcadv_cen2, ln_trcadv_tvd 59 USE zdfmxl, ONLY: hmld 55 60 56 61 !! time (integer timestep) … … 62 67 REAL(wp) :: fq0,fq1,fq2,fq3 63 68 69 # if defined key_roam 70 !!---------------------------------------------------------------------- 71 !! AXY (09/08/17): fix benthic submodel 64 72 !!---------------------------------------------------------------------- 65 73 !! Process benthic in/out fluxes 66 74 !! These can be handled outside of the 3D calculations since the 67 !! benthic pools (and fluxes) are 2D in nature; this code is68 !! (shamelessly) borrowed from corresponding code in the LOBSTER69 !! model75 !! benthic pools (and fluxes) are 2D in nature; this code was 76 !! developed with help from George Nurser (NOC); it cannot be run 77 !! in a configuration with variable time-stepping with depth 70 78 !!---------------------------------------------------------------------- 71 79 !! 72 !! IF(lwp) WRITE(numout,*) 'AXY: rdt = ', rdt80 !! time-step calculation 73 81 if (jorgben.eq.1) then 74 za_sed_n(:,:) = zn_sed_n(:,:) + & 75 ( f_sbenin_n(:,:) + f_fbenin_n(:,:) - & 76 f_benout_n(:,:) ) * (rdt / 86400.) 82 za_sed_n(:,:) = zb_sed_n(:,:) + ((2. * (rdt / 86400.)) * & 83 ( f_sbenin_n(:,:) + f_fbenin_n(:,:) - f_benout_n(:,:) )) 84 za_sed_fe(:,:) = zb_sed_fe(:,:) + ((2. * (rdt / 86400.)) * & 85 ( f_sbenin_fe(:,:) + f_fbenin_fe(:,:) - f_benout_fe(:,:) )) 86 za_sed_c(:,:) = zb_sed_c(:,:) + ((2. * (rdt / 86400.)) * & 87 ( f_sbenin_c(:,:) + f_fbenin_c(:,:) - f_benout_c(:,:) )) 88 endif 89 if (jinorgben.eq.1) then 90 za_sed_si(:,:) = zb_sed_si(:,:) + ((2. * (rdt / 86400.)) * & 91 ( f_fbenin_si(:,:) - f_benout_si(:,:) )) 92 za_sed_ca(:,:) = zb_sed_ca(:,:) + ((2. * (rdt / 86400.)) * & 93 ( f_fbenin_ca(:,:) - f_benout_ca(:,:) )) 94 endif 95 !! 96 !! time-level calculation 97 if (jorgben.eq.1) then 98 zb_sed_n(:,:) = zn_sed_n(:,:) + (atfp * & 99 ( za_sed_n(:,:) - (2. * zn_sed_n(:,:)) + zb_sed_n(:,:) )) 77 100 zn_sed_n(:,:) = za_sed_n(:,:) 78 !! 79 za_sed_fe(:,:) = zn_sed_fe(:,:) + & 80 ( f_sbenin_fe(:,:) + f_fbenin_fe(:,:) - & 81 f_benout_fe(:,:) ) * (rdt / 86400.) 101 zb_sed_fe(:,:) = zn_sed_fe(:,:) + (atfp * & 102 ( za_sed_fe(:,:) - (2. * zn_sed_fe(:,:)) + zb_sed_fe(:,:) )) 82 103 zn_sed_fe(:,:) = za_sed_fe(:,:) 83 !! 84 za_sed_c(:,:) = zn_sed_c(:,:) + & 85 ( f_sbenin_c(:,:) + f_fbenin_c(:,:) - & 86 f_benout_c(:,:) ) * (rdt / 86400.) 104 zb_sed_c(:,:) = zn_sed_c(:,:) + (atfp * & 105 ( za_sed_c(:,:) - (2. * zn_sed_c(:,:)) + zb_sed_c(:,:) )) 87 106 zn_sed_c(:,:) = za_sed_c(:,:) 88 107 endif 89 108 if (jinorgben.eq.1) then 90 za_sed_si(:,:) = zn_sed_si(:,:) + & 91 ( f_fbenin_si(:,:) - f_benout_si(:,:) ) * & 92 (rdt / 86400.) 109 zb_sed_si(:,:) = zn_sed_si(:,:) + (atfp * & 110 ( za_sed_si(:,:) - (2. * zn_sed_si(:,:)) + zb_sed_si(:,:) )) 93 111 zn_sed_si(:,:) = za_sed_si(:,:) 94 !! 95 za_sed_ca(:,:) = zn_sed_ca(:,:) + & 96 ( f_fbenin_ca(:,:) - f_benout_ca(:,:) ) * & 97 (rdt / 86400.) 112 zb_sed_ca(:,:) = zn_sed_ca(:,:) + (atfp * & 113 ( za_sed_ca(:,:) - (2. * zn_sed_ca(:,:)) + zb_sed_ca(:,:) )) 98 114 zn_sed_ca(:,:) = za_sed_ca(:,:) 99 115 endif 100 !! 101 if (ibenthic.eq.2) then 102 !! The code below (in this if ... then ... endif loop) is 103 !! effectively commented out because it does not work as 104 !! anticipated; it can be deleted at a later date 105 if (jorgben.eq.1) then 106 za_sed_n(:,:) = ( f_sbenin_n(:,:) + f_fbenin_n(:,:) - & 107 f_benout_n(:,:) ) * rdt 108 za_sed_fe(:,:) = ( f_sbenin_fe(:,:) + f_fbenin_fe(:,:) - & 109 f_benout_fe(:,:) ) * rdt 110 za_sed_c(:,:) = ( f_sbenin_c(:,:) + f_fbenin_c(:,:) - & 111 f_benout_c(:,:) ) * rdt 112 endif 113 if (jinorgben.eq.1) then 114 za_sed_si(:,:) = ( f_fbenin_si(:,:) - f_benout_si(:,:) ) * rdt 115 za_sed_ca(:,:) = ( f_fbenin_ca(:,:) - f_benout_ca(:,:) ) * rdt 116 endif 116 # endif 117 118 IF ( ln_foam_medusa ) THEN 119 !!---------------------------------------------------------------------- 120 !! Diagnostics required for ocean colour assimilation: 121 !! Mixed layer average phytoplankton growth, loss and concentration 122 !! Maximum mixed layer depth 123 !!---------------------------------------------------------------------- 117 124 !! 118 !! Leap-frog scheme - only in explicit case, otherwise the 119 !! time stepping is already being done in trczdf 120 !! IF( l_trczdf_exp .AND. (ln_trcadv_cen2 .OR. ln_trcadv_tvd) ) THEN 121 !! zfact = 2. * rdttra(jk) * FLOAT( ndttrc ) 122 !! IF( neuler == 0 .AND. kt == nittrc000 ) zfact = rdttra(jk) * 123 !! FLOAT(ndttrc) 124 !! if (jorgben.eq.1) then 125 !! za_sed_n(:,:) = zb_sed_n(:,:) + ( zfact * za_sed_n(:,:) ) 126 !! za_sed_fe(:,:) = zb_sed_fe(:,:) + ( zfact * za_sed_fe(:,:) ) 127 !! za_sed_c(:,:) = zb_sed_c(:,:) + ( zfact * za_sed_c(:,:) ) 128 !! endif 129 !! if (jinorgben.eq.1) then 130 !! za_sed_si(:,:) = zb_sed_si(:,:) + ( zfact * za_sed_si(:,:) ) 131 !! za_sed_ca(:,:) = zb_sed_ca(:,:) + ( zfact * za_sed_ca(:,:) ) 132 !! endif 133 !! ENDIF 134 !! 135 !! Time filter and swap of arrays 136 IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN ! centred or tvd scheme 137 IF( neuler == 0 .AND. kt == nittrc000 ) THEN 138 if (jorgben.eq.1) then 139 zb_sed_n(:,:) = zn_sed_n(:,:) 140 zn_sed_n(:,:) = za_sed_n(:,:) 141 za_sed_n(:,:) = 0.0 142 !! 143 zb_sed_fe(:,:) = zn_sed_fe(:,:) 144 zn_sed_fe(:,:) = za_sed_fe(:,:) 145 za_sed_fe(:,:) = 0.0 146 !! 147 zb_sed_c(:,:) = zn_sed_c(:,:) 148 zn_sed_c(:,:) = za_sed_c(:,:) 149 za_sed_c(:,:) = 0.0 150 endif 151 if (jinorgben.eq.1) then 152 zb_sed_si(:,:) = zn_sed_si(:,:) 153 zn_sed_si(:,:) = za_sed_si(:,:) 154 za_sed_si(:,:) = 0.0 155 !! 156 zb_sed_ca(:,:) = zn_sed_ca(:,:) 157 zn_sed_ca(:,:) = za_sed_ca(:,:) 158 za_sed_ca(:,:) = 0.0 159 endif 160 ELSE 161 if (jorgben.eq.1) then 162 zb_sed_n(:,:) = (atfp * & 163 ( zb_sed_n(:,:) + za_sed_n(:,:) )) + & 164 (atfp1 * zn_sed_n(:,:) ) 165 zn_sed_n(:,:) = za_sed_n(:,:) 166 za_sed_n(:,:) = 0.0 167 !! 168 zb_sed_fe(:,:) = (atfp * & 169 ( zb_sed_fe(:,:) + za_sed_fe(:,:) )) + & 170 (atfp1 * zn_sed_fe(:,:)) 171 zn_sed_fe(:,:) = za_sed_fe(:,:) 172 za_sed_fe(:,:) = 0.0 173 !! 174 zb_sed_c(:,:) = (atfp * & 175 ( zb_sed_c(:,:) + za_sed_c(:,:) )) + & 176 (atfp1 * zn_sed_c(:,:) ) 177 zn_sed_c(:,:) = za_sed_c(:,:) 178 za_sed_c(:,:) = 0.0 179 endif 180 if (jinorgben.eq.1) then 181 zb_sed_si(:,:) = (atfp * & 182 ( zb_sed_si(:,:) + za_sed_si(:,:) )) + & 183 (atfp1 * zn_sed_si(:,:)) 184 zn_sed_si(:,:) = za_sed_si(:,:) 185 za_sed_si(:,:) = 0.0 186 !! 187 zb_sed_ca(:,:) = (atfp * & 188 ( zb_sed_ca(:,:) + za_sed_ca(:,:) )) + & 189 (atfp1 * zn_sed_ca(:,:)) 190 zn_sed_ca(:,:) = za_sed_ca(:,:) 191 za_sed_ca(:,:) = 0.0 192 endif 193 ENDIF 194 ELSE ! case of smolar scheme or muscl 195 if (jorgben.eq.1) then 196 zb_sed_n(:,:) = za_sed_n(:,:) 197 zn_sed_n(:,:) = za_sed_n(:,:) 198 za_sed_n(:,:) = 0.0 199 !! 200 zb_sed_fe(:,:) = za_sed_fe(:,:) 201 zn_sed_fe(:,:) = za_sed_fe(:,:) 202 za_sed_fe(:,:) = 0.0 203 !! 204 zb_sed_c(:,:) = za_sed_c(:,:) 205 zn_sed_c(:,:) = za_sed_c(:,:) 206 za_sed_c(:,:) = 0.0 207 endif 208 if (jinorgben.eq.1) then 209 zb_sed_si(:,:) = za_sed_si(:,:) 210 zn_sed_si(:,:) = za_sed_si(:,:) 211 za_sed_si(:,:) = 0.0 212 !! 213 zb_sed_ca(:,:) = za_sed_ca(:,:) 214 zn_sed_ca(:,:) = za_sed_ca(:,:) 215 za_sed_ca(:,:) = 0.0 216 endif 217 ENDIF 218 endif 125 DO jj = 2,jpjm1 126 DO ji = 2,jpim1 127 IF ( hmld(ji,jj) .GT. 0.0 ) THEN 128 pgrow_avg(ji,jj) = pgrow_avg(ji,jj) / hmld(ji,jj) 129 ploss_avg(ji,jj) = ploss_avg(ji,jj) / hmld(ji,jj) 130 phyt_avg(ji,jj) = phyt_avg(ji,jj) / hmld(ji,jj) 131 IF ( hmld(ji,jj) .GT. mld_max(ji,jj) ) THEN 132 mld_max(ji,jj) = hmld(ji,jj) 133 ENDIF 134 ENDIF 135 END DO 136 END DO 137 ENDIF 219 138 220 139 # if defined key_debug_medusa … … 253 172 fq1 = f_sbenin_n(ji,jj) + f_fbenin_n(ji,jj) 254 173 fq2 = fq0 + fq1 255 IF (lwp) write (numout,'(a,2i3,a,3f15.10)') & 256 'AXY N cons: (i,j)=',ji,jj,', (flx,ben,err)=', & 257 fq0,fq1,fq2 174 fq3 = f_benout_n(ji,jj) 175 if (lwp) write (numout,'a,2i3,a,4f15,5)') & 176 'AXY N cons: (i,j)=',ji,jj,', (flx,ben,err,out)=', & 177 fq0,fq1,fq2,fq3 258 178 ENDIF 259 179 ENDDO … … 266 186 fq1 = f_fbenin_si(ji,jj) 267 187 fq2 = fq0 + fq1 268 IF (lwp) write (numout,'(a,2i3,a,3f15.10)') & 269 'AXY Si cons: (i,j)=',ji,jj,', (flx,ben,err)=', & 270 fq0,fq1,fq2 188 fq3 = f_benout_si(ji,jj) 189 if (lwp) write (numout,'a,2i3,a,4f15,5)') & 190 'AXY Si cons: (i,j)=',ji,jj,', (flx,ben,err,out)=', & 191 fq0,fq1,fq2,fq3 271 192 ENDIF 272 193 ENDDO … … 278 199 fq0 = fflx_c(ji,jj) 279 200 fq1 = f_sbenin_c(ji,jj) + f_fbenin_c(ji,jj) + f_fbenin_ca(ji,jj) 280 fq2 = f_co2flux(ji,jj) * e3t_n(ji,jj,1)201 fq2 = f_co2flux(ji,jj) * fse3t(ji,jj,1) 281 202 fq3 = fq0 + fq1 282 IF (lwp) write (numout,'(a,2i3,a,4f15.10)') & 283 'AXY C cons: (i,j)=',ji,jj,', (flx,ben,asf,err)=', & 284 fq0,fq1,fq2,fq3 285 ENDIF 286 ENDDO 287 ENDDO 288 !! alkalinity 289 DO jj = 2,jpjm1 290 DO ji = 2,jpim1 291 if (tmask(ji,jj,1) == 1) then 292 fq0 = fflx_a(ji,jj) 293 fq1 = 2.0 * f_fbenin_ca(ji,jj) 294 fq2 = fq0 + fq1 295 IF (lwp) write (numout,'(a,2i3,a,3f15.10)') & 296 'AXY alk cons: (i,j)=',ji,jj,', (flx,ben,err)=', & 297 fq0,fq1,fq2 203 fq4 = f_benout_c(ji,jj) + f_benout_ca(ji,jj) 204 if (lwp) write (numout,'a,2i3,a,5f15,5)') & 205 'AXY C cons: (i,j)=',ji,jj,', (flx,ben,asf,err,out)=', & 206 fq0,fq1,fq2,fq3,fq4 207 ENDIF 208 ENDDO 209 ENDDO 210 !! alkalinity 211 DO jj = 2,jpjm1 212 DO ji = 2,jpim1 213 if (tmask(ji,jj,1) == 1) then 214 fq0 = fflx_a(ji,jj) 215 fq1 = 2.0 * f_fbenin_ca(ji,jj) 216 fq2 = fq0 + fq1 217 fq3 = 2.0 * f_benout_ca(ji,jj) 218 if (lwp) write (numout,'a,2i3,a,4f15,5)') & 219 'AXY alk cons: (i,j)=',ji,jj,', (flx,ben,err,out)=', & 220 fq0,fq1,fq2,fq3 298 221 ENDIF 299 222 ENDDO … … 333 256 ENDDO 334 257 ENDDO 258 259 !!!--------------------------------------------------------------- 260 !! Calculates Chl diag for UM coupling 261 !!!--------------------------------------------------------------- 262 !! JPALM -- 02-06-2017 -- 263 !! add Chl surf coupling 264 !! no need to output, just pass to cpl var 265 IF (lk_oasis) THEN 266 IF (chl_out.eq.1) THEN 267 !! export and scale surface chl 268 zn_chl_srf(:,:) = MAX( 0.0, (trn(:,:,1,jpchd) + trn(:,:,1,jpchn)) * 1.0E-6 ) 269 !! surf Chl in Kg-chl/m3 as needed for cpl 270 ELSEIF (chl_out.eq.2) THEN 271 !! export and scale mld chl 272 zn_chl_srf(:,:) = MAX( 0.0, fchl_ml(:,:) * 1.0E-6 ) 273 !! mld Chl in Kg-chl/m3 as needed for cpl 274 ENDIF 275 chloro_out_cpl(:,:) = zn_chl_srf(:,:) * scl_chl !! Coupling Chl 276 END IF 277 335 278 !!---------------------------------------------------------------- 336 279 !! Add in XML diagnostics stuff … … 360 303 CALL iom_put( "OCAL_LVL" , fccd ) 361 304 ENDIF 305 IF ( med_diag%CHL_MLD%dgsave ) THEN 306 CALL iom_put( "CHL_MLD" , fchl_ml ) 307 ENDIF 308 IF (lk_oasis) THEN 309 IF ( med_diag%CHL_CPL%dgsave ) THEN 310 CALL iom_put( "CHL_CPL" , chloro_out_cpl ) 311 ENDIF 312 ENDIF 362 313 IF ( med_diag%PN_JLIM%dgsave ) THEN 363 314 CALL iom_put( "PN_JLIM" , fjln2d ) -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_medusa_init.F90
r8442 r10302 6 6 !! History : 7 7 !! - ! 2017-04 (M. Stringer) Code taken from trcbio_medusa.F90 8 !! - ! 2017-08 (A. Yool) Add slow-sinking detrius variables 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_medusa … … 34 35 USE bio_medusa_mod 35 36 USE par_oce, ONLY: jpi, jpj, jpk 36 USE sms_medusa, ONLY: jdms 37 USE sms_medusa, ONLY: jdms, pgrow_avg, ploss_avg, phyt_avg, mld_max 37 38 USE trc, ONLY: ln_diatrc, med_diag, nittrc000 38 USE in_out_manager, ONLY: lwp 39 40 # if defined key_iomput 41 USE iom, ONLY: lk_iomput, numout 39 USE in_out_manager, ONLY: lwp, numout 40 41 USE iom, ONLY: lk_iomput 42 42 USE trcnam_medusa, ONLY: trc_nam_iom_medusa 43 # endif44 43 45 44 !! time (integer timestep) … … 161 160 fprn_ml(:,:) = 0.0 !! mixed layer PP diagnostics 162 161 fprd_ml(:,:) = 0.0 !! mixed layer PP diagnostics 162 !! AXY (16/08/17) 163 fchl_ml(:,:) = 0.0 !! mixed layer chlorophyll diagnostics 163 164 !! 164 165 fslownflux(:,:) = 0.0 165 166 fslowcflux(:,:) = 0.0 167 !! 168 !! JPALM -- 21-09-2017 -- needed to debug air-sea carb 169 f_xco2a(:,:) = 0.0 170 f_pco2w(:,:) = 0.0 171 f_ph(:,:) = 0.0 172 f_kw660(:,:) = 0.0 173 ztmp(:,:) = 0.0 174 zsal(:,:) = 0.0 175 zalk(:,:) = 0.0 176 zdic(:,:) = 0.0 177 zsil(:,:) = 0.0 178 # if defined key_mocsy 179 ! zpho is only defined if key_mocsy 180 ! is active, so we must protect this 181 ! initialisation accordingly. 182 zpho(:,:) = 0.0 183 # endif 184 f_co2flux(:,:) = 0.0 185 f_pco2atm(:,:) = 0.0 186 f_h2co3(:,:) = 0.0 187 f_hco3(:,:) = 0.0 188 f_co3(:,:) = 0.0 189 f_omarg(:,:) = 0.0 190 f_omcal(:,:) = 0.0 191 !! 192 !! AXY (08/08/17): zero slow detritus fluxes 193 fslowsink(:,:) = 0.0 194 # if defined key_roam 195 fslowsinkc(:,:) = 0.0 196 # endif 197 !! 198 pgrow_avg(:,:) = 0.0 199 ploss_avg(:,:) = 0.0 200 phyt_avg(:,:) = 0.0 201 IF( kt == nittrc000 ) THEN 202 mld_max(:,:) = 0.0 203 ENDIF 166 204 !! 167 205 !! allocate and initiate 2D diag … … 836 874 CONTAINS 837 875 SUBROUTINE bio_medusa_init( ) ! Empty routine 876 IMPLICIT NONE 838 877 WRITE(*,*) 'bio_medusa_init: You should not have seen this print! error?' 839 878 END SUBROUTINE bio_medusa_init -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_medusa_mod.F90
r8442 r10302 7 7 !! History : 8 8 !! - ! 2017-04 (M. Stringer) Code taken from trcbio_medusa.F90 9 !! - ! 2017-08 (A. Yool) Slow detritus, ML-avg chl variables 9 10 !!---------------------------------------------------------------------- 10 11 #if defined key_medusa … … 54 55 !! AXY (01/03/10): add in mixed layer PP diagnostics 55 56 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fprn_ml,fprd_ml 57 !! AXY (16/08/17): add in mixed layer chlorophyll diagnostic 58 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fchl_ml 56 59 !! 57 60 !! nutrient limiting factors … … 94 97 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fregenfastc 95 98 # endif 96 99 !! 100 !! AXY (08/08/17): sinking of detritus moved here 101 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fslowsink, fslowgain, fslowloss 102 # if defined key_roam 103 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fslowsinkc, fslowgainc, fslowlossc 104 # endif 105 !! 97 106 !! Particle flux 98 107 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fdep1 … … 287 296 fjlim_pn(jpi,jpj),fjlim_pd(jpi,jpj), & 288 297 fun_T(jpi,jpj),fun_Q10(jpi,jpj), & 289 fprn_ml(jpi,jpj),fprd_ml(jpi,jpj), 298 fprn_ml(jpi,jpj),fprd_ml(jpi,jpj),fchl_ml(jpi,jpj), & 290 299 fnln(jpi,jpj),ffln2(jpi,jpj), & 291 300 fnld(jpi,jpj),ffld(jpi,jpj),fsld(jpi,jpj), & … … 316 325 fregenfastc(jpi,jpj), & 317 326 # endif 327 fslowsink(jpi,jpj),fslowgain(jpi,jpj), & 328 fslowloss(jpi,jpj), & 329 # if defined key_roam 330 fslowsinkc(jpi,jpj),fslowgainc(jpi,jpj), & 331 fslowlossc(jpi,jpj), & 332 # endif 318 333 fdep1(jpi,jpj), & 319 334 ftempn(jpi,jpj),ftempsi(jpi,jpj),ftempfe(jpi,jpj), & -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_medusa_update.F90
r8442 r10302 6 6 !! History : 7 7 !! - ! 2017-04 (M. Stringer) Code taken from trcbio_medusa.F90 8 !! - ! 2017-08 (A. Yool) Amend slow-detritus bug 9 !! - ! 2017-08 (A. Yool) Reformatting for clarity 8 10 !!---------------------------------------------------------------------- 9 11 #if defined key_medusa … … 60 62 fsil_cons, fsil_prod, fsdiss, & 61 63 ftempca, fthetad, fthetan, & 64 fslowsink, fslowgain, fslowloss, & ! AXY (22/08/17) 65 f_sbenin_n, f_sbenin_c, & 62 66 # if defined key_roam 67 fslowsinkc, fslowgainc, fslowlossc, & ! AXY (22/08/17) 63 68 fcar_cons, fcar_prod, fcomm_resp, & 64 69 fddc, fflx_a, fflx_c, fflx_o2, zoxy, & … … 66 71 # endif 67 72 zpds, zphd, zphn 68 USE dom_oce, ONLY: e3t_0, e3t_n, gphit, mbathy, tmask 73 USE dom_oce, ONLY: e3t_0, gphit, mbathy, tmask 74 # if defined key_vvl 75 USE dom_oce, ONLY: e3t_n 76 # endif 69 77 USE in_out_manager, ONLY: lwp, numout 70 78 USE lib_mpp, ONLY: ctl_stop 71 79 USE par_kind, ONLY: wp 72 USE par_medusa, ONLY: jp_medusa, 80 USE par_medusa, ONLY: jp_medusa, jp_msa0, jp_msa1, & 73 81 jpalk, jpchd, jpchn, jpdet, jpdic, & 74 82 jpdin, jpdtc, jpfer, jpoxy, jppds, & … … 78 86 jpoxy_lc, jppds_lc, jpphd_lc, jpphn_lc, & 79 87 jpsil_lc, jpzme_lc, jpzmi_lc 80 USE par_oce, ONLY: jpi, jpim1, jpj, jpjm1 88 USE par_oce, ONLY: jpi, jpim1, jpj, jpjm1, jpk 81 89 USE par_trc, ONLY: jptra 82 90 USE sms_medusa, ONLY: friver_dep, & … … 181 189 ENDDO 182 190 183 DO jj = 2,jpjm1 184 DO ji = 2,jpim1 185 if (tmask(ji,jj,jk) == 1) then 186 !! 187 !!---------------------------------------------------------- 188 !! detritus 189 btra(ji,jj,jpdet_lc) = b0 * & 190 ! mort. losses 191 (fdpn(ji,jj) + ((1.0 - xfdfrac1) * & 192 fdpd(ji,jj)) + & 193 fdzmi(ji,jj) + & 194 ((1.0 - xfdfrac2) * fdzme(ji,jj)) + & 195 ! assim. inefficiency 196 ((1.0 - xbetan) * (finmi(ji,jj) + & 197 finme(ji,jj))) - & 198 ! grazing and remin. 199 fgmid(ji,jj) - fgmed(ji,jj) - & 200 fdd(ji,jj) + & 201 ! seafloor fast->slow 202 ffast2slown(ji,jj)) 203 !! 191 !!---------------------------------------------------------- 192 !! detritus 193 DO jj = 2,jpjm1 194 DO ji = 2,jpim1 195 if (tmask(ji,jj,jk) == 1) then 196 !! 197 btra(ji,jj,jpdet_lc) = b0 * ( & 198 fdpn(ji,jj) & ! mort. losses 199 + ((1.0 - xfdfrac1) * fdpd(ji,jj)) & ! mort. losses 200 + fdzmi(ji,jj) & ! mort. losses 201 + ((1.0 - xfdfrac2) * fdzme(ji,jj)) & ! mort. losses 202 + ((1.0 - xbetan) * (finmi(ji,jj) + finme(ji,jj))) & ! assim. inefficiency 203 - fgmid(ji,jj) - fgmed(ji,jj) & ! grazing 204 - fdd(ji,jj) & ! remin. 205 + fslowgain(ji,jj) - fslowloss(ji,jj) & ! slow-sinking 206 - (f_sbenin_n(ji,jj) / fse3t(ji,jj,jk)) & ! slow-sinking loss to seafloor 207 + ffast2slown(ji,jj) ) ! seafloor fast->slow 204 208 ENDIF 205 209 ENDDO … … 266 270 ! mort. loss 267 271 ((1.0 - xfdfrac1) * fdpds(ji,jj)) + & 268 &! egestion of grazed Si272 ! egestion of grazed Si 269 273 ((1.0 - xfdfrac3) * fgmepds(ji,jj)) + & 270 274 ! fast diss. and metab. losses … … 305 309 ffetop(ji,jj) + ffebot(ji,jj) - & 306 310 ffescav(ji,jj) ) 311 ENDIF 312 ENDDO 313 ENDDO 314 307 315 # if defined key_roam 308 !! 309 !!---------------------------------------------------------- 310 !! AXY (26/11/08): implicit detrital carbon change 311 btra(ji,jj,jpdtc_lc) = b0 * ( & 312 ! mort. losses 313 (xthetapn * fdpn(ji,jj)) + & 314 ((1.0 - xfdfrac1) * & 315 (xthetapd * fdpd(ji,jj))) + & 316 (xthetazmi * fdzmi(ji,jj)) + & 317 ((1.0 - xfdfrac2) * & 318 (xthetazme * fdzme(ji,jj))) + & 319 ! assim. inefficiency 320 ((1.0 - xbetac) * & 321 (ficmi(ji,jj) + ficme(ji,jj))) - & 322 ! grazing and remin. 323 fgmidc(ji,jj) - fgmedc(ji,jj) - & 324 fddc(ji,jj) + & 325 ! seafloor fast->slow 326 ffast2slowc(ji,jj) ) 316 !!---------------------------------------------------------- 317 !! AXY (26/11/08): implicit detrital carbon change 318 DO jj = 2,jpjm1 319 DO ji = 2,jpim1 320 if (tmask(ji,jj,jk) == 1) then 321 !! 322 btra(ji,jj,jpdtc_lc) = b0 * ( & 323 (xthetapn * fdpn(ji,jj)) & ! mort. losses 324 + ((1.0 - xfdfrac1) * (xthetapd * fdpd(ji,jj))) & ! mort. losses 325 + (xthetazmi * fdzmi(ji,jj)) & ! mort. losses 326 + ((1.0 - xfdfrac2) * (xthetazme * fdzme(ji,jj))) & ! mort. losses 327 + ((1.0 - xbetac) * (ficmi(ji,jj) + ficme(ji,jj))) & ! assim. inefficiency 328 - fgmidc(ji,jj) - fgmedc(ji,jj) & ! grazing 329 - fddc(ji,jj) & ! remin. 330 + fslowgainc(ji,jj) - fslowlossc(ji,jj) & ! slow-sinking 331 - (f_sbenin_c(ji,jj) / fse3t(ji,jj,jk)) & ! slow-sinking loss to seafloor 332 + ffast2slowc(ji,jj) ) ! seafloor fast->slow 327 333 ENDIF 328 334 ENDDO … … 575 581 f_o2flux(ji,jj)) 576 582 endif 583 ENDIF 584 ENDDO 585 ENDDO 577 586 # endif 578 ENDIF579 ENDDO580 ENDDO581 587 582 588 # if defined key_debug_medusa -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/MEDUSA/carb_chem.F90
r8441 r10302 40 40 # endif 41 41 zalk, zdic, zsal, zsil, ztmp 42 USE dom_oce, ONLY: gdept_0, gdept_n, gdepw_0, gdepw_n, & 43 gphit, mbathy, tmask 42 USE dom_oce, ONLY: gdept_0, gdepw_0, gphit, mbathy, tmask 43 # if defined key_vvl 44 USE dom_oce, ONLY: gdept_n, gdepw_n 45 # endif 44 46 USE in_out_manager, ONLY: lwp, numout 45 47 USE oce, ONLY: PCO2a_in_cpl, tsb, tsn … … 103 105 !! OPEN wet point IF..THEN loop 104 106 IF (tmask(ji,jj,jk).eq.1) THEN 105 IF (lk_oasis) THEN106 !! use 2D atm xCO2 from atm coupling107 f_xco2a(ji,jj) = PCO2a_in_cpl(ji,jj)108 ENDIF109 107 !! Do carbonate chemistry 110 108 !! -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/MEDUSA/detritus.F90
r8441 r10302 6 6 !! History : 7 7 !! - ! 2017-04 (M. Stringer) Code taken from trcbio_medusa.F90 8 !! - ! 2017-08 (A. Yool) Revise slow-sinking of detritus 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_medusa … … 35 36 f_sbenin_n, fdd, & 36 37 idf, idfval, & 37 # if defined key_roam 38 fslowsink, & 39 fslowgain, fslowloss, & 40 # if defined key_roam 41 fslowsinkc, & 42 fslowgainc, fslowlossc, & 38 43 fddc, & 39 44 # endif 40 45 fun_T, fun_Q10, zdet, zdtc 41 46 USE detritus_fast_sink_mod, ONLY: detritus_fast_sink 42 USE dom_oce, ONLY: mbathy, tmask 47 USE dom_oce, ONLY: mbathy, e3t_0, gphit, tmask 48 # if defined key_vvl 49 USE dom_oce, ONLY: e3t_n 50 # endif 43 51 USE in_out_manager, ONLY: lwp, numout 44 52 USE par_oce, ONLY: jpim1, jpjm1 45 53 USE sms_medusa, ONLY: jmd, jorgben, jsfd, vsed, & 46 54 xrfn, xmd, xmdc, xthetad 55 56 !!* Substitution 57 # include "domzgr_substitute.h90" 47 58 48 59 !! Level … … 123 134 DO ji = 2,jpim1 124 135 if (tmask(ji,jj,jk) == 1) then 136 !!---------------------------------------------------------------------- 137 !! Detritus sinking (AXY, 08/08/18) 138 !! Replaces slow-sinking done in trcsed_medusa.F90 139 !! 140 !! Uses the fslowsink variable to carry slow-sinking detritus from one 141 !! grid level to the next, variable fslowgain to "add" detritus sinking 142 !! from above and variable fslowloss to "subtract" detritus sinking out 143 !! to below; these variables appear in the differential equations of 144 !! detrital nitrogen and carbon below 145 !!---------------------------------------------------------------------- 146 !! 147 fslowgain(ji,jj) = fslowsink(ji,jj) / fse3t(ji,jj,jk) ! = mmol N / m3 / d 148 if (jk.lt.mbathy(ji,jj)) then 149 fslowloss(ji,jj) = (zdet(ji,jj) * vsed * 86400.) / fse3t(ji,jj,jk) ! = mmol N / m3 / d 150 else 151 fslowloss(ji,jj) = 0. ! = mmol N / m3 / d 152 endif 153 fslowsink(ji,jj) = fslowloss(ji,jj) * fse3t(ji,jj,jk) ! = mmol N / m2 / d 154 !! 155 # if defined key_roam 156 fslowgainc(ji,jj) = fslowsinkc(ji,jj) / fse3t(ji,jj,jk) ! = mmol C / m3 / d 157 if (jk.lt.mbathy(ji,jj)) then 158 fslowlossc(ji,jj) = (zdtc(ji,jj) * vsed * 86400.) / fse3t(ji,jj,jk) ! = mmol C / m3 / d 159 else 160 fslowlossc(ji,jj) = 0. ! = mmol C / m3 / d 161 endif 162 fslowsinkc(ji,jj) = fslowlossc(ji,jj) * fse3t(ji,jj,jk) ! = mmol C / m2 / d 163 # endif 164 ENDIF 165 ENDDO 166 ENDDO 167 168 DO jj = 2,jpjm1 169 DO ji = 2,jpim1 170 if (tmask(ji,jj,jk) == 1) then 125 171 !!--------------------------------------------------------- 126 172 !! Detritus addition to benthos -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/MEDUSA/detritus_fast_sink.F90
r8441 r10302 66 66 idf, idfval, & 67 67 zdet, zdtc 68 USE dom_oce, ONLY: e3t_0, e3t_n, gdepw_0, gdepw_n, & 69 gphit, mbathy, tmask 68 USE dom_oce, ONLY: e3t_0, gdepw_0, gphit, mbathy, tmask 69 # if defined key_vvl 70 USE dom_oce, ONLY: e3t_n, gdepw_n 71 # endif 70 72 USE in_out_manager, ONLY: lwp, numout 71 73 USE oce, ONLY: tsn -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/MEDUSA/iron_chem_scav.F90
r8441 r10302 35 35 zdet, zfer, zphd, zphn, zzme, zzmi, & 36 36 idf, idfval 37 USE dom_oce, ONLY: e3t_0, e3t_n, gdepw_0, gdepw_n, & 38 mbathy, tmask 37 USE dom_oce, ONLY: e3t_0, gdepw_0, mbathy, tmask 38 #if defined key_vvl 39 USE dom_oce, ONLY: e3t_n, gdepw_n 40 #endif 39 41 USE par_kind, ONLY: wp 40 42 USE in_out_manager, ONLY: lwp, numout -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/MEDUSA/phytoplankton.F90
r8441 r10302 6 6 !! History : 7 7 !! - ! 2017-04 (M. Stringer) Code taken from trcbio_medusa.F90 8 !! - ! 2017-08 (A. Yool) Mean mixed layer chlorophyll 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_medusa … … 42 43 zchd, zchn, zdet, zdin, zdtc, & 43 44 zfer, zpds, zphd, zphn, zsil, & 44 zzme, zzmi 45 USE dom_oce, ONLY: e3t_0, e3t_n, gdepw_0, gdepw_n, tmask 45 zzme, zzmi, fchl_ml 46 USE dom_oce, ONLY: e3t_0, gdepw_0, tmask 47 #if defined key_vvl 48 USE dom_oce, ONLY: e3t_n, gdepw_n 49 #endif 46 50 USE in_out_manager, ONLY: lwp, numout 47 51 USE oce, ONLY: tsn … … 55 59 xvpd, xvpn, xxi 56 60 USE zdfmxl, ONLY: hmld 61 USE lbclnk, ONLY: lbc_lnk 57 62 58 63 !!* Substitution … … 373 378 fprd_ml(ji,jj) = fprd_ml(ji,jj) + (fprd(ji,jj) * zphd(ji,jj) * & 374 379 fse3t(ji,jj,jk) * fq0) 375 ENDIF 376 ENDDO 377 ENDDO 380 !! AXY (16/08/17) 381 fchl_ml(ji,jj) = fchl_ml(ji,jj) + ((zchn(ji,jj) + zchd(ji,jj)) * & 382 (fse3t(ji,jj,jk) * fq0) / hmld(ji,jj)) 383 ENDIF 384 ENDDO 385 ENDDO 386 CALL lbc_lnk(fchl_ml(:,:),'T',1. ) 378 387 379 388 DO jj = 2,jpjm1 -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/MEDUSA/plankton.F90
r8441 r10302 36 36 fdpn, fdpn2, fdzme, fdzme2, & 37 37 fdzmi, fdzmi2, fsdiss, fsin, & 38 fdep1, fprn, fprd, & 39 fgmepd, fgmepn, fgmipn, & 38 40 zphd, zphn, zpds, zzme, zzmi 39 USE dom_oce, ONLY: tmask 41 USE dom_oce, ONLY: e3t_0, e3t_n, gdepw_0, gdepw_n, tmask 42 USE par_kind, ONLY: wp 40 43 USE par_oce, ONLY: jpim1, jpjm1 41 44 USE phytoplankton_mod, ONLY: phytoplankton 42 45 USE sms_medusa, ONLY: jmpd, jmpn, jmzme, jmzmi, & 46 ln_foam_medusa, & 47 pgrow_avg, ploss_avg, phyt_avg, & 43 48 xkphd, xkphn, xkzme, xkzmi, & 44 49 xmetapd, xmetapn, xmetazme, xmetazmi, & 45 50 xmpd, xmpn, xmzme, xmzmi, xsdiss 51 USE zdfmxl, ONLY: hmld 46 52 USE zooplankton_mod, ONLY: zooplankton 53 54 !!* Substitution 55 # include "domzgr_substitute.h90" 47 56 48 57 !! Level … … 50 59 51 60 INTEGER :: ji, jj 61 62 REAL(wp) :: fq0 52 63 53 64 !!------------------------------------------------------------------- … … 188 199 ENDDO 189 200 201 IF ( ln_foam_medusa ) THEN 202 !! Mixed layer averages for ocean colour assimilation 203 !! 204 DO jj = 2,jpjm1 205 DO ji = 2,jpim1 206 IF (tmask(ji,jj,jk) == 1) THEN 207 if (fdep1(ji,jj).le.hmld(ji,jj)) then 208 !! this level is entirely in the mixed layer 209 fq0 = 1.0 210 elseif (fsdepw(ji,jj,jk).ge.hmld(ji,jj)) then 211 !! this level is entirely below the mixed layer 212 fq0 = 0.0 213 else 214 !! this level straddles the mixed layer 215 fq0 = (hmld(ji,jj) - fsdepw(ji,jj,jk)) / fse3t(ji,jj,jk) 216 endif 217 !! 218 pgrow_avg(ji,jj) = pgrow_avg(ji,jj) + & 219 (((fprn(ji,jj) * zphn(ji,jj)) + & 220 (fprd(ji,jj) * zphd(ji,jj)) ) * & 221 fse3t(ji,jj,jk) * fq0) 222 ploss_avg(ji,jj) = ploss_avg(ji,jj) + & 223 ((fgmepd(ji,jj) + fdpd(ji,jj) + & 224 fdpd2(ji,jj) + & 225 fgmepn(ji,jj) + fdpn(ji,jj) + & 226 fdpn2(ji,jj) + fgmipn(ji,jj) ) * & 227 fse3t(ji,jj,jk) * fq0) 228 phyt_avg(ji,jj) = phyt_avg(ji,jj) + & 229 ((zphn(ji,jj) + zphd(ji,jj)) * & 230 fse3t(ji,jj,jk) * fq0) 231 ENDIF 232 ENDDO 233 ENDDO 234 ENDIF 235 190 236 END SUBROUTINE plankton 191 237 -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/MEDUSA/sms_medusa.F90
r8132 r10302 177 177 INTEGER :: jdms_model !: choice of DMS model passed to atmosphere 178 178 !! 1 = ANDR, 2 = SIMO, 3 = ARAN, 4 = HALL 179 !! 179 !! JPALM --19-12-2017 -- UM people need to tune the Anderson DMS scheme 180 REAL(wp) :: dmsmin !: Anderson DMS scheme - DMS minimum value 181 REAL(wp) :: dmscut !: Anderson DMS scheme - DMS cutoff value 182 REAL(wp) :: dmsslp !: Anderson DMS scheme - DMS slope 183 !! FOR UKESM 184 REAL(wp) :: scl_chl !: scaling factor for tuned Chl passed to the UM 185 INTEGER :: chl_out !: select Chl field exported and scaled for UM: 186 !: 1- Surface Chl ; 2- MLD Chl 180 187 !! 181 188 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: remdmp !: depth dependent damping coefficient of passive tracers … … 205 212 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: f2_ccd_arg !: 2D aragonite CCD depth 206 213 !! 214 !! 2D fields of pCO2 and fCO2 for observation operator 215 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: f2_pco2w !: 2D pCO2 216 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: f2_fco2w !: 2D fCO2 217 !! 207 218 !! 2D fields of organic and inorganic material sedimented on the seafloor 208 219 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zb_sed_n !: 2D organic nitrogen (before) … … 276 287 #if defined key_roam 277 288 !!---------------------------------------------------------------------- 278 !! Atmospheric pCO2 data (1859 to 2100 inclusive) 279 !!---------------------------------------------------------------------- 280 !! 281 REAL(wp), DIMENSION(242) :: hist_pco2 !: pCO2 282 283 # if defined key_rcp26 284 !! UKMO, run AJKKH + KAAEC, RCP 2.6, pCO2 time evolution 285 DATA hist_pco2 / 286.0230, 286.1730, 286.3230, 286.4480, 286.5730, & 286 & 286.7230, 286.8480, 286.9480, 287.0480, 287.1730, & 287 & 287.3230, 287.4730, 287.6480, 287.8480, 288.0730, & 288 & 288.3480, 288.6480, 288.9730, 289.3470, 289.7470, & 289 & 290.1730, 290.6470, 291.1470, 291.6220, 292.0720, & 290 & 292.5220, 292.9220, 293.2470, 293.5220, 293.7470, & 291 & 293.9470, 294.1220, 294.2720, 294.4220, 294.5470, & 292 & 294.6470, 294.7470, 294.8470, 294.9710, 295.1710, & 293 & 295.4460, 295.7470, 296.0720, 296.4210, 296.7710, & 294 & 297.1460, 297.5710, 298.0210, 298.4460, 298.8460, & 295 & 299.2460, 299.6450, 300.0210, 300.3710, 300.7200, & 296 & 301.0450, 301.3460, 301.6710, 302.0200, 302.3450, & 297 & 302.6450, 302.9700, 303.3450, 303.7200, 304.0700, & 298 & 304.4700, 304.9200, 305.3440, 305.7700, 306.2450, & 299 & 306.7190, 307.1700, 307.6440, 308.1190, 308.5440, & 300 & 308.9440, 309.3440, 309.6940, 309.9440, 310.1190, & 301 & 310.2440, 310.3190, 310.3190, 310.2440, 310.1440, & 302 & 310.0690, 310.0440, 310.0690, 310.1440, 310.2690, & 303 & 310.4440, 310.6940, 311.0430, 311.4440, 311.8690, & 304 & 312.3680, 312.9430, 313.5430, 314.1680, 314.7900, & 305 & 315.4430, 316.2150, 317.0170, 317.7370, 318.3400, & 306 & 318.8680, 319.5900, 320.5890, 321.5470, 322.5770, & 307 & 323.8440, 324.9260, 325.7960, 327.0810, 328.6180, & 308 & 329.6830, 330.5250, 331.6880, 333.2120, 334.7870, & 309 & 336.4640, 338.2990, 339.6660, 340.7310, 342.1360, & 310 & 343.7200, 345.2200, 346.7350, 348.5820, 350.6740, & 311 & 352.4230, 353.7910, 354.9530, 355.8210, 356.7130, & 312 & 358.0630, 359.7720, 361.3970, 363.0900, 365.2560, & 313 & 367.2810, 368.7980, 370.4000, 372.4550, 374.6920, & 314 & 376.7440, 378.7440, 380.7580, 382.7080, 384.7300, & 315 & 386.9310, 389.2150, 391.4910, 393.7710, 396.0460, & 316 & 398.3240, 400.6080, 402.8950, 405.1780, 407.4550, & 317 & 409.7260, 411.9930, 414.2500, 416.4410, 418.5280, & 318 & 420.5250, 422.4390, 424.2720, 426.0200, 427.6750, & 319 & 429.2360, 430.7050, 432.0850, 433.3580, 434.5140, & 320 & 435.5740, 436.5490, 437.4420, 438.2550, 438.9810, & 321 & 439.6110, 440.1430, 440.5770, 440.9450, 441.2660, & 322 & 441.5410, 441.7840, 442.0050, 442.2040, 442.3780, & 323 & 442.5210, 442.6200, 442.6720, 442.6810, 442.6540, & 324 & 442.5830, 442.4670, 442.3270, 442.1680, 441.9960, & 325 & 441.8060, 441.5930, 441.3440, 441.0540, 440.7230, & 326 & 440.3510, 439.9300, 439.4650, 438.9730, 438.4630, & 327 & 437.9400, 437.4020, 436.8400, 436.2640, 435.6850, & 328 & 435.1030, 434.5160, 433.9170, 433.3060, 432.7010, & 329 & 432.1110, 431.5380, 430.9810, 430.4320, 429.8860, & 330 & 429.3370, 428.7810, 428.2220, 427.6490, 427.0660, & 331 & 426.4890, 425.9270, 425.3840, 424.8610, 424.3540, & 332 & 423.8540, 423.3540, 422.8530, 422.3510, 421.8410, & 333 & 421.3250, 420.8190 / 334 # else 335 !! UKMO, run AJKKH + KAAEF, RCP 8.5, pCO2 time evolution 336 DATA hist_pco2 / 286.0230, 286.1730, 286.3230, 286.4480, 286.5730, & 337 & 286.7230, 286.8480, 286.9480, 287.0480, 287.1730, & 338 & 287.3230, 287.4730, 287.6480, 287.8480, 288.0730, & 339 & 288.3480, 288.6480, 288.9730, 289.3470, 289.7470, & 340 & 290.1730, 290.6470, 291.1470, 291.6220, 292.0720, & 341 & 292.5220, 292.9220, 293.2470, 293.5220, 293.7470, & 342 & 293.9470, 294.1220, 294.2720, 294.4220, 294.5470, & 343 & 294.6470, 294.7470, 294.8470, 294.9710, 295.1710, & 344 & 295.4460, 295.7470, 296.0720, 296.4210, 296.7710, & 345 & 297.1460, 297.5710, 298.0210, 298.4460, 298.8460, & 346 & 299.2460, 299.6450, 300.0210, 300.3710, 300.7200, & 347 & 301.0450, 301.3460, 301.6710, 302.0200, 302.3450, & 348 & 302.6450, 302.9700, 303.3450, 303.7200, 304.0700, & 349 & 304.4700, 304.9200, 305.3440, 305.7700, 306.2450, & 350 & 306.7190, 307.1700, 307.6440, 308.1190, 308.5440, & 351 & 308.9440, 309.3440, 309.6940, 309.9440, 310.1190, & 352 & 310.2440, 310.3190, 310.3190, 310.2440, 310.1440, & 353 & 310.0690, 310.0440, 310.0690, 310.1440, 310.2690, & 354 & 310.4440, 310.6940, 311.0430, 311.4440, 311.8690, & 355 & 312.3680, 312.9430, 313.5430, 314.1680, 314.7900, & 356 & 315.4430, 316.2150, 317.0170, 317.7370, 318.3400, & 357 & 318.8680, 319.5900, 320.5890, 321.5470, 322.5770, & 358 & 323.8440, 324.9260, 325.7960, 327.0810, 328.6180, & 359 & 329.6830, 330.5250, 331.6880, 333.2120, 334.7870, & 360 & 336.4640, 338.2990, 339.6660, 340.7310, 342.1360, & 361 & 343.7200, 345.2200, 346.7350, 348.5820, 350.6740, & 362 & 352.4230, 353.7910, 354.9530, 355.8210, 356.7130, & 363 & 358.0630, 359.7720, 361.3970, 363.0900, 365.2560, & 364 & 367.2810, 368.7980, 370.4000, 372.4550, 374.6920, & 365 & 376.7440, 378.7440, 380.7580, 382.7080, 384.7300, & 366 & 386.9420, 389.2540, 391.5670, 393.9370, 396.3920, & 367 & 398.9320, 401.5550, 404.2550, 407.0220, 409.8530, & 368 & 412.7470, 415.7050, 418.7210, 421.7880, 424.9180, & 369 & 428.1200, 431.3970, 434.7470, 438.1650, 441.6410, & 370 & 445.1700, 448.7530, 452.3920, 456.0950, 459.8810, & 371 & 463.7680, 467.7660, 471.8750, 476.0960, 480.4210, & 372 & 484.8390, 489.3470, 493.9430, 498.6400, 503.4380, & 373 & 508.3410, 513.3630, 518.5160, 523.8050, 529.2290, & 374 & 534.7780, 540.4450, 546.2230, 552.1120, 558.1110, & 375 & 564.2110, 570.4130, 576.7390, 583.1990, 589.7980, & 376 & 596.5390, 603.4110, 610.4060, 617.4940, 624.6500, & 377 & 631.8800, 639.1750, 646.5360, 653.9800, 661.5230, & 378 & 669.1840, 676.9570, 684.8290, 692.7790, 700.7690, & 379 & 708.8050, 716.8870, 725.0020, 733.1770, 741.3900, & 380 & 749.6700, 758.0480, 766.5050, 775.0350, 783.6110, & 381 & 792.2200, 800.8740, 809.5680, 818.2760, 827.0090, & 382 & 835.8020, 844.6550, 853.5730, 862.5690, 871.6190, & 383 & 880.7020, 889.8240, 898.9590, 908.1270, 917.3080, & 384 & 926.4960, 935.7040 / 385 # endif 289 !! JPALM -- change hist_pco2 init 290 !!---------------------------------------------------------------------- 291 !! 292 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: hist_pco2 !: pCO2 293 INTEGER :: co2_rec 294 REAL(wp) :: co2_yinit, co2_yend !: First and Last year read in the xCO2.atm file 295 REAL(wp) :: xobs_xco2a !: Observed atmospheric xCO2, from namelist 296 #endif 297 298 !!---------------------------------------------------------------------- 299 !! JPALM -- PI CO2 key 300 !!---------------------------------------------------------------------- 301 !! 302 #if defined key_axy_pi_co2 303 LOGICAL , PUBLIC :: lk_pi_co2 = .TRUE. !: PI xCO2 used 304 #else 305 LOGICAL , PUBLIC :: lk_pi_co2 = .FALSE. !: PI xCO2 unused 386 306 #endif 387 307 … … 434 354 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: cmask !: ??? 435 355 356 !!---------------------------------------------------------------------- 357 !! Parameters required for ocean colour assimilation 358 !!---------------------------------------------------------------------- 359 !! 360 LOGICAL :: ln_foam_medusa !: Flag to calculate and save diagnostics 361 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: pgrow_avg !: Mixed layer average phytoplankton growth 362 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ploss_avg !: Mixed layer average phytoplankton loss 363 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: phyt_avg !: Mixed layer average phytoplankton 364 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: mld_max !: Maximum mixed layer depth 365 !! 366 436 367 !!---------------------------------------------------------------------- 437 368 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 446 377 !!---------------------------------------------------------------------- 447 378 USE lib_mpp , ONLY: ctl_warn 448 INTEGER :: ierr( 8) ! Local variables379 INTEGER :: ierr(9) ! Local variables 449 380 !!---------------------------------------------------------------------- 450 381 ierr(:) = 0 … … 456 387 !* 2D and 3D fields of carbonate system parameters 457 388 ALLOCATE( f2_ccd_cal(jpi,jpj) , f2_ccd_arg(jpi,jpj) , & 389 f2_pco2w(jpi,jpj) , f2_fco2w(jpi,jpj) , & 458 390 & f3_pH(jpi,jpj,jpk) , f3_h2co3(jpi,jpj,jpk), & 459 391 & f3_hco3(jpi,jpj,jpk) , f3_co3(jpi,jpj,jpk) , & … … 504 436 & ffln(jpi,jpj,jpk) , fflf(jpi,jpj,jpk) , & 505 437 & ffls(jpi,jpj,jpk) , cmask(jpi,jpj) , STAT=ierr(8) ) 438 !* Fields for ocean colour data assimilation 439 ALLOCATE( pgrow_avg(jpi,jpj) , ploss_avg(jpi,jpj) , & 440 & phyt_avg(jpi,jpj) , mld_max(jpi,jpj) , STAT=ierr(9) ) 506 441 #endif 507 442 ! -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcbio_medusa.F90
r8442 r10302 23 23 !! - ! 2016-11 (A. Yool) Updated diags for CMIP6 24 24 !! - ! 2017-05 (A. Yool) Added extra DMS calculation 25 !! - ! 2017-11 (J. Palm, A. Yool) Diagnose tracer excursions 25 26 !!---------------------------------------------------------------------- 26 27 !! … … 77 78 zfer, zpds, zphd, zphn, zsil, & 78 79 zzme, zzmi 79 USE dom_oce, ONLY: e3t_0, e3t_n, & 80 gdept_0, gdept_n, & 81 gdepw_0, gdepw_n, & 82 nday_year, nsec_day, nyear, & 83 rdt, tmask 80 USE dom_oce, ONLY: e3t_0, gdept_0, gdepw_0, & 81 nday_year, nsec_day, & 82 nyear, nyear_len, ndastp, & 83 nsec_month, & 84 rdt, tmask, mig, mjg, nimpp, & 85 njmpp 86 #if defined key_vvl 87 USE dom_oce, ONLY: e3t_n, gdept_n, gdepw_n 88 #endif 89 84 90 USE in_out_manager, ONLY: lwp, numout, nn_date0 85 # if defined key_iomput86 91 USE iom, ONLY: lk_iomput 87 # endif88 92 USE lbclnk, ONLY: lbc_lnk 89 USE lib_mpp, ONLY: ctl_stop 90 USE oce, ONLY: tsb, tsn 93 USE lib_mpp, ONLY: mpp_max, mpp_maxloc, & 94 mpp_min, mpp_minloc, & 95 ctl_stop, ctl_warn, lk_mpp 96 USE oce, ONLY: tsb, tsn, PCO2a_in_cpl 91 97 USE par_kind, ONLY: wp 92 98 USE par_medusa, ONLY: jpalk, jpchd, jpchn, jpdet, & … … 98 104 !! JPALM (27-06-2016): add lk_oasis for CO2 and DMS coupling with atm 99 105 USE sbc_oce, ONLY: lk_oasis 100 USE sms_medusa, ONLY: hist_pco2 106 USE sms_medusa, ONLY: hist_pco2, co2_yinit, co2_yend, & 107 # if defined key_roam 108 xobs_xco2a, & 109 # endif 110 pgrow_avg, & 111 ploss_avg, phyt_avg, mld_max, & 112 lk_pi_co2, ln_foam_medusa 101 113 USE trc, ONLY: ln_rsttr, nittrc000, trn 102 114 USE bio_medusa_init_mod, ONLY: bio_medusa_init … … 110 122 USE bio_medusa_diag_slice_mod, ONLY: bio_medusa_diag_slice 111 123 USE bio_medusa_fin_mod, ONLY: bio_medusa_fin 124 USE trcstat, ONLY: trc_rst_dia_stat 112 125 113 126 IMPLICIT NONE … … 115 128 116 129 PUBLIC trc_bio_medusa ! called in trcsms_medusa.F90 130 PUBLIC trc_bio_exceptionnal_fix ! here 117 131 118 132 !!* Substitution … … 176 190 !! 177 191 !! temporary variables 178 REAL(wp) :: fq0,fq1,fq2,fq3,fq4 192 REAL(wp) :: fq3,fq4 193 REAL(wp) :: this_y, this_d, this_s, fyear 194 !! 195 !! T and S check temporary variable 196 REAL(wp) :: sumtsn, tsnavg 197 INTEGER :: summask 198 CHARACTER(40) :: charout, charout2, charout3, charout4, charout5 179 199 !! 180 200 !!------------------------------------------------------------------ … … 283 303 !!------------------------------------------------------------------ 284 304 !! 285 !! what's atmospheric pCO2 doing? (data start in 1859) 286 iyr1 = nyear - 1859 + 1 287 iyr2 = iyr1 + 1 288 if (iyr1 .le. 1) then 289 !! before 1860 290 f_xco2a(:,:) = hist_pco2(1) 291 elseif (iyr2 .ge. 242) then 292 !! after 2099 293 f_xco2a(:,:) = hist_pco2(242) 294 else 295 !! just right 296 fq0 = hist_pco2(iyr1) 297 fq1 = hist_pco2(iyr2) 298 fq2 = real(nsec_day) / (60.0 * 60.0 * 24.0) 299 !! AXY (14/06/12): tweaked to make more sense (and be correct) 300 # if defined key_bs_axy_yrlen 301 !! bugfix: for 360d year with HadGEM2-ES forcing 302 fq3 = (real(nday_year) - 1.0 + fq2) / 360.0 303 # else 304 !! original use of 365 days (not accounting for leap year or 305 !! 360d year) 306 fq3 = (real(nday_year) - 1.0 + fq2) / 365.0 307 # endif 308 fq4 = (fq0 * (1.0 - fq3)) + (fq1 * fq3) 309 f_xco2a(:,:) = fq4 310 endif 311 # if defined key_axy_pi_co2 312 !! OCMIP pre-industrial pCO2 313 !! f_xco2a(:,:) = 284.725 !! CMIP5 pre-industrial pCO2 314 f_xco2a = 284.317 !! CMIP6 pre-industrial pCO2 315 # endif 316 !! IF(lwp) WRITE(numout,*) ' MEDUSA nyear =', nyear 317 !! IF(lwp) WRITE(numout,*) ' MEDUSA nsec_day =', real(nsec_day) 318 !! IF(lwp) WRITE(numout,*) ' MEDUSA nday_year =', real(nday_year) 319 !! AXY (29/01/14): remove surplus diagnostics 320 !! IF(lwp) WRITE(numout,*) ' MEDUSA fq0 =', fq0 321 !! IF(lwp) WRITE(numout,*) ' MEDUSA fq1 =', fq1 322 !! IF(lwp) WRITE(numout,*) ' MEDUSA fq2 =', fq2 323 !! IF(lwp) WRITE(numout,*) ' MEDUSA fq3 =', fq3 324 IF(lwp) WRITE(numout,*) ' MEDUSA atm pCO2 =', f_xco2a(1,1) 305 IF (lk_oasis) THEN 306 !! xCO2 from coupled 307 IF ( ( kt == nittrc000 ) .AND. lwp ) & 308 WRITE(numout,*) '** MEDUSA Atm xCO2 given by the UM **' 309 f_xco2a(:,:) = PCO2a_in_cpl(:,:) 310 !! Check the xCO2 from the UM is OK 311 !! piece of code moved from air-sea.F90 312 !!--- 313 DO jj = 2,jpjm1 314 DO ji = 2,jpim1 315 !! OPEN wet point IF..THEN loop 316 IF (tmask(ji,jj,1) == 1) then 317 !!! Jpalm test on atm xCO2 318 IF ( (f_xco2a(ji,jj) .GT. 10000.0 ).OR. & 319 (f_xco2a(ji,jj) .LE. 0.0 ) ) THEN 320 IF(lwp) THEN 321 WRITE(numout,*) ' atm xCO2 = ',f_xco2a(ji,jj), & 322 ' -- ji =', mig(ji),' jj = ', mjg(jj) 323 ENDIF 324 CALL ctl_stop( 'MEDUSA - trc_bio :', & 325 'unrealistic coupled atm xCO2 ' ) 326 ENDIF 327 ENDIF 328 ENDDO 329 ENDDO 330 !!--- 331 ELSEIF (lk_pi_co2) THEN 332 !! OCMIP pre-industrial xCO2 333 IF ( ( kt == nittrc000 ) .AND. lwp ) & 334 WRITE(numout,*) '** MEDUSA Atm xCO2 fixed to pre-industrial value **' 335 !! f_xco2a(:,:) = 284.725 !! CMIP5 pre-industrial pCO2 336 f_xco2a(:,:) = 284.317 !! CMIP6 pre-industrial pCO2 337 ELSEIF ( xobs_xco2a > 0.0 ) THEN 338 IF(lwp) WRITE(numout,*) ' using observed atm pCO2 = ', xobs_xco2a 339 f_xco2a(:,:) = xobs_xco2a 340 ELSE 341 !! xCO2 from file 342 !! AXY - JPALM new interpolation scheme usinf nyear_len 343 this_y = real(nyear) 344 this_d = real(nday_year) 345 this_s = real(nsec_day) 346 !! 347 fyear = this_y + ((this_d - 1) + (this_s / (60. * 60. * 24.))) / real(nyear_len(1)) 348 !! 349 IF ( ( kt == nittrc000 ) .AND. lwp ) THEN 350 WRITE(numout,*) '** MEDUSA Atm xCO2 from file **' 351 WRITE(numout,*) ' MEDUSA year =', this_y 352 WRITE(numout,*) ' Year length =', real(nyear_len(1)) 353 WRITE(numout,*) ' MEDUSA nday_year =', this_d 354 WRITE(numout,*) ' MEDUSA nsec_day =', this_s 355 ENDIF 356 !! 357 !! different case test 358 IF (fyear .LE. co2_yinit) THEN 359 !! before first record -- pre-industrial value 360 f_xco2a(:,:) = hist_pco2(1) 361 ELSEIF (fyear .GE. co2_yend) THEN 362 !! after last record - continue to use the last value 363 f_xco2a(:,:) = hist_pco2(int(co2_yend - co2_yinit + 1.) ) 364 ELSE 365 !! just right 366 iyr1 = int(fyear - co2_yinit) + 1 367 iyr2 = iyr1 + 1 368 fq3 = fyear - real(iyr1) - co2_yinit + 1. 369 fq4 = ((1 - fq3) * hist_pco2(iyr1)) + (fq3 * hist_pco2(iyr2)) 370 f_xco2a(:,:) = fq4 371 !! 372 IF ( ( kt == nittrc000 ) .AND. lwp ) THEN 373 WRITE(numout,*) ' MEDUSA year1 =', iyr1 374 WRITE(numout,*) ' MEDUSA year2 =', iyr2 375 WRITE(numout,*) ' xCO2 year1 =', hist_pco2(iyr1) 376 WRITE(numout,*) ' xCO2 year2 =', hist_pco2(iyr2) 377 WRITE(numout,*) ' Year2 weight =', fq3 378 ENDIF 379 ENDIF 380 ENDIF 381 382 !! Writing xCO2 in output on start and on the 1st tsp of each month 383 IF ( (kt == nittrc000 .AND. .NOT.ln_rsttr) .OR. & 384 ( nsec_month .LE. INT(rdt) ) ) THEN 385 IF ( lwp ) WRITE(numout,*) ' *** Atm xCO2 *** -- kt:', kt, & 386 '; current date:', ndastp 387 call trc_rst_dia_stat(f_xco2a(:,:), 'atm xCO2') 388 ENDIF 325 389 # endif 326 390 … … 348 412 !! x * 30d + 1*rdt(i.e: mod = rdt) 349 413 !! ++ need to pass carb-chem output var through restarts 350 If ( (kt == nittrc000 .AND. .NOT.ln_rsttr) .OR. & 351 ((86400*mod(nn_date0,100) + mod(kt*rdt,2592000.)) == rdt) ) THEN 414 !!If ( (kt == nitt8rc000 .AND. .NOT.ln_rsttr) .OR. & 415 !! ( (mod(kt*rdt,2592000.)) == rdt) THEN 416 !!============================= 417 !! (Jpalm -- updated for restartability issues) 418 !! We want this to be start of month or if starting afresh from 419 !! climatology - marc 20/6/17 420 !!If ( (kt == nittrc000 .AND. .NOT.ln_rsttr) .OR. & 421 !! ((86400*mod(nn_date0,100) + mod(kt*rdt,2592000.)) == rdt) ) THEN 422 !!============================= 423 !! Jpalm -- 15-02-2018 -- need to change 3D carb-chem call freq again. 424 !! previous call did not work, probably the (86400*mod(nn_date0,100) part 425 !! should not be in... 426 !! now use the NEMO calendar tool : nsec_month to be sure to call 427 !! at the beginning of a new month . 428 !! DAF: For FOAM we want to run daily 429 IF ( (kt == nittrc000 .AND. .NOT.ln_rsttr) .OR. & 430 ( nsec_month .LE. INT(rdt) ) .OR. & 431 ( nsec_day .LE. INT(rdt) .AND. ln_foam_medusa ) ) THEN 432 IF ( lwp ) WRITE(numout,*) & 433 ' *** 3D carb chem call *** -- kt:', kt, & 434 '; current date:', ndastp 352 435 !!--------------------------------------------------------------- 353 436 !! Calculate the carbonate chemistry for the whole ocean on the first … … 450 533 451 534 # if defined key_roam 535 !! extra MEDUSA-2 tracers 452 536 DO jj = 2,jpjm1 453 537 DO ji = 2,jpim1 … … 456 540 zdtc(ji,jj) = max(0.,trn(ji,jj,jk,jpdtc)) 457 541 !! dissolved inorganic carbon 458 zdic(ji,jj) = max(0.,trn(ji,jj,jk,jpdic))542 zdic(ji,jj) = trn(ji,jj,jk,jpdic) 459 543 !! alkalinity 460 zalk(ji,jj) = max(0.,trn(ji,jj,jk,jpalk))544 zalk(ji,jj) = trn(ji,jj,jk,jpalk) 461 545 !! oxygen 462 546 zoxy(ji,jj) = max(0.,trn(ji,jj,jk,jpoxy)) … … 470 554 ztmp(ji,jj) = tsn(ji,jj,jk,jp_tem) 471 555 zsal(ji,jj) = tsn(ji,jj,jk,jp_sal) 472 !!473 !! AXY (28/02/14): check input fields474 if (ztmp(ji,jj) .lt. -3.0 .or. ztmp(ji,jj) .gt. 40.0 ) then475 IF(lwp) WRITE(numout,*) &476 ' trc_bio_medusa: T WARNING 2D, ', &477 tsb(ji,jj,jk,jp_tem), tsn(ji,jj,jk,jp_tem), &478 ' at (', ji, ',', jj, ',', jk, ') at time', kt479 IF(lwp) WRITE(numout,*) &480 ' trc_bio_medusa: T SWITCHING 2D, ', &481 tsn(ji,jj,jk,jp_tem), ' -> ', tsb(ji,jj,jk,jp_tem)482 !! temperatur483 ztmp(ji,jj) = tsb(ji,jj,jk,jp_tem)484 endif485 if (zsal(ji,jj) .lt. 0.0 .or. zsal(ji,jj) .gt. 45.0 ) then486 IF(lwp) WRITE(numout,*) &487 ' trc_bio_medusa: S WARNING 2D, ', &488 tsb(ji,jj,jk,jp_sal), tsn(ji,jj,jk,jp_sal), &489 ' at (', ji, ',', jj, ',', jk, ') at time', kt490 endif491 556 ENDIF 492 557 ENDDO 493 558 ENDDO 494 559 # else 560 !! diagnostic MEDUSA-1 detrital carbon tracer 495 561 DO jj = 2,jpjm1 496 562 DO ji = 2,jpim1 497 if (tmask(ji,jj,jk) == 1) then563 IF (tmask(ji,jj,jk) == 1) THEN 498 564 !! implicit detrital carbon 499 565 zdtc(ji,jj) = zdet(ji,jj) * xthetad … … 502 568 ENDDO 503 569 # endif 570 571 # if defined key_roam 572 !! --------------------------------------------- 573 !! JPALM -- 14-12-2017 -- Here, before any exeptionnal crazy value is 574 !! removed, we want to tell to the Master Processor that this 575 !! Exceptionnal value did exist 576 !! 577 Call trc_bio_check(kt, jk) 578 579 !!================================================================ 580 !! AXY (03/11/17): check input fields 581 !! tracer values that exceed thresholds can cause carbonate system 582 !! failures when passed to MOCSY; temporary temperature excursions 583 !! in recent UKESM0.8 runs trigger such failures but are too short 584 !! to have physical consequences; this section checks for such 585 !! values and amends them using neighbouring values 586 !! 587 !! the check on temperature here is also carried out at the end of 588 !! each model time step and anomalies are reported in the master 589 !! ocean.output file; the error reporting below is strictly local 590 !! to the relevant ocean.output_XXXX file so will not be visible 591 !! unless all processors are reporting output 592 !!================================================================ 593 !! 594 DO jj = 2,jpjm1 595 DO ji = 2,jpim1 596 if (tmask(ji,jj,jk) == 1) then 597 !! the thresholds for the four tracers are ... 598 IF ( (ztmp(ji,jj) .LT. -3.0) .OR. (ztmp(ji,jj) .GT. 40.0 ) .OR. & 599 (zsal(ji,jj) .LE. 0.0) .OR. (zsal(ji,jj) .GT. 50.0 ) .OR. & 600 (zdic(ji,jj) .LE. 0.0) .OR. (zdic(ji,jj) .GT. 4.0E3 ) .OR. & 601 (zalk(ji,jj) .LE. 0.0) .OR. (zalk(ji,jj) .GT. 4.0E3 ) ) THEN 602 !! 603 !! all tracer values are reported in the event of any excursion 604 IF (lwp) THEN 605 WRITE(charout,*) ' Tmp = ', ztmp(ji,jj) 606 WRITE(charout2,*) ' Sal = ', zsal(ji,jj) 607 WRITE(charout3,*) ' DIC = ', zdic(ji,jj) 608 WRITE(charout4,*) ' Alk = ', zalk(ji,jj) 609 WRITE(charout5,*) mig(ji), mjg(jj), jk, kt 610 CALL ctl_warn( 'trc_bio_medusa: carbonate chemistry WARNING:', & 611 TRIM(charout),TRIM(charout2),TRIM(charout3),TRIM(charout4), & 612 'at i, j, k, kt:', TRIM(charout5) ) 613 ENDIF 614 !! 615 !! Detect, report and correct tracer excursions 616 IF ( (ztmp(ji,jj) .LT. -3.0) .OR. (ztmp(ji,jj) .GT. 40.0) ) & 617 CALL trc_bio_exceptionnal_fix( & 618 tsn(ji-1:ji+1,jj-1:jj+1,jk,jp_tem), tmask(ji-1:ji+1,jj-1:jj+1,jk), & 619 'Tmp', -3.0, 40.0, ztmp(ji,jj) ) 620 !! 621 IF ( (zsal(ji,jj) .LE. 0.0) .OR. (zsal(ji,jj) .GT. 50.0) ) & 622 CALL trc_bio_exceptionnal_fix( & 623 tsn(ji-1:ji+1,jj-1:jj+1,jk,jp_sal), tmask(ji-1:ji+1,jj-1:jj+1,jk), & 624 'Sal', 1.0, 50.0, zsal(ji,jj) ) 625 !! 626 IF ( (zdic(ji,jj) .LE. 0.0) .OR. (zdic(ji,jj) .GT. 4.0E3) ) & 627 CALL trc_bio_exceptionnal_fix( & 628 trn(ji-1:ji+1,jj-1:jj+1,jk,jpdic), tmask(ji-1:ji+1,jj-1:jj+1,jk), & 629 'DIC', 100.0, 4.0E3, zdic(ji,jj) ) 630 !! 631 IF ( (zalk(ji,jj) .LE. 0.0) .OR. (zalk(ji,jj) .GT. 4.0E3) ) & 632 CALL trc_bio_exceptionnal_fix( & 633 trn(ji-1:ji+1,jj-1:jj+1,jk,jpalk), tmask(ji-1:ji+1,jj-1:jj+1,jk), & 634 'Alk', 100.0, 4.0E3, zalk(ji,jj) ) 635 ENDIF 636 ENDIF 637 ENDDO 638 ENDDO 639 # endif 640 504 641 # if defined key_debug_medusa 505 642 DO jj = 2,jpjm1 … … 657 794 END SUBROUTINE trc_bio_medusa 658 795 796 797 798 SUBROUTINE trc_bio_exceptionnal_fix(tiny_var, tiny_mask, var_nm, mini, maxi, varout) 799 !! JPALM (27/10/17): This function is called only when abnormal values that 800 !! could break the model's carbonate system are fed to MEDUSA 801 !! 802 !! The function calculates an average tracer value based on the 3x3 cell 803 !! neighbourhood around the abnormal cell, and reports this back 804 !! 805 !! Tracer array values are not modified, but MEDUSA uses "corrected" values 806 !! in its calculations 807 !! 808 !! temporary variables 809 REAL(wp), INTENT( in ), DIMENSION(3,3) :: tiny_var, tiny_mask 810 CHARACTER(3), INTENT( in ) :: var_nm 811 REAL(wp), INTENT( in ) :: mini, maxi 812 REAL(wp), INTENT( out ) :: varout 813 REAL(wp) :: sumtsn, tsnavg 814 INTEGER :: summask 815 CHARACTER(25) :: charout1, charout2 816 CHARACTER(60) :: charout3, charout4 817 INTEGER :: ii,ij 818 819 !! point to the center of the 3*3 zoom-grid, to check around 820 ii = 2 821 ij = 2 822 !! Print surounding values to check if isolated Crazy value or 823 !! General error 824 IF(lwp) THEN 825 WRITE(numout,*) & 826 '----------------------------------------------------------------------' 827 WRITE(numout,*) & 828 'trc_bio_medusa: 3x3 neighbourhood surrounding abnormal ', TRIM(var_nm) 829 WRITE(numout,9100) & 830 3, tiny_var(ii-1,ij+1), tiny_var(ii ,ij+1), tiny_var(ii+1,ij+1) 831 WRITE(numout,9100) & 832 2, tiny_var(ii-1,ij ), tiny_var(ii ,ij ), tiny_var(ii+1,ij ) 833 WRITE(numout,9100) & 834 1, tiny_var(ii-1,ij-1), tiny_var(ii ,ij-1), tiny_var(ii+1,ij-1) 835 WRITE(numout,*) & 836 'trc_bio_medusa: 3x3 land-sea neighbourhood, tmask' 837 WRITE(numout,9100) & 838 3, tiny_mask(ii-1,ij+1), tiny_mask(ii ,ij+1), tiny_mask(ii+1,ij+1) 839 WRITE(numout,9100) & 840 2, tiny_mask(ii-1,ij ), tiny_mask(ii ,ij ), tiny_mask(ii+1,ij ) 841 WRITE(numout,9100) & 842 1, tiny_mask(ii-1,ij-1), tiny_mask(ii ,ij-1), tiny_mask(ii+1,ij-1) 843 ENDIF 844 !! Correct out of range values 845 sumtsn = ( tiny_mask(ii-1,ij+1) * tiny_var(ii-1,ij+1) ) + & 846 ( tiny_mask(ii ,ij+1) * tiny_var(ii ,ij+1) ) + & 847 ( tiny_mask(ii+1,ij+1) * tiny_var(ii+1,ij+1) ) + & 848 ( tiny_mask(ii-1,ij ) * tiny_var(ii-1,ij ) ) + & 849 ( tiny_mask(ii+1,ij ) * tiny_var(ii+1,ij ) ) + & 850 ( tiny_mask(ii-1,ij-1) * tiny_var(ii-1,ij-1) ) + & 851 ( tiny_mask(ii ,ij-1) * tiny_var(ii ,ij-1) ) + & 852 ( tiny_mask(ii+1,ij-1) * tiny_var(ii+1,ij-1) ) 853 !! 854 summask = tiny_mask(ii-1,ij+1) + tiny_mask(ii ,ij+1) + & 855 tiny_mask(ii+1,ij+1) + tiny_mask(ii-1,ij ) + & 856 tiny_mask(ii+1,ij ) + tiny_mask(ii-1,ij-1) + & 857 tiny_mask(ii ,ij-1) + tiny_mask(ii+1,ij-1) 858 !! 859 IF ( summask .GT. 0 ) THEN 860 tsnavg = ( sumtsn / summask ) 861 varout = MAX( MIN( maxi, tsnavg), mini ) 862 ELSE 863 IF (ztmp(ii,ij) .LT. mini ) varout = mini 864 IF (ztmp(ii,ij) .GT. maxi ) varout = maxi 865 ENDIF 866 !! 867 IF (lwp) THEN 868 WRITE(charout1,9200) tiny_var(ii,ij) 869 WRITE(charout2,9200) varout 870 WRITE(charout3,*) ' ', charout1, ' -> ', charout2 871 WRITE(charout4,*) ' Tracer: ', trim(var_nm) 872 !! 873 WRITE(numout,*) 'trc_bio_medusa: ** EXCEPTIONAL VALUE SWITCHING **' 874 WRITE(numout,*) charout4 875 WRITE(numout,*) charout3 876 WRITE(numout,*) '----------------------------------------------------------------------' 877 WRITE(numout,*) ' ' 878 ENDIF 879 880 9100 FORMAT('Row:', i1, ' ', e16.6, ' ', e16.6, ' ', e16.6) 881 9200 FORMAT(e16.6) 882 883 END SUBROUTINE trc_bio_exceptionnal_fix 884 885 SUBROUTINE trc_bio_check(kt, jk) 886 !!----------------------------------- 887 !! JPALM -- 14-12-2017 -- Still dealing with this micro-boil/carb failure 888 !! problem. The model is now able to correct a local 889 !! crazy value. but does it silently. 890 !! We need to spread the word to the master processor. we 891 !! don't want the model to correct values without telling us 892 !! This module will tell at least when crazy DIC or 893 !! ALK appears. 894 !!------------------------------------- 895 REAL(wp) :: zmax, zmin ! temporary scalars 896 INTEGER :: ji,jj ! dummy loop 897 INTEGER :: ii,ij ! temporary scalars 898 INTEGER, DIMENSION(2) :: ilocs ! 899 INTEGER, INTENT( in ) :: kt, jk 900 !! 901 !!========================== 902 !! DIC Check 903 zmax = -5.0 ! arbitrary low maximum value 904 zmin = 4.0E4 ! arbitrary high minimum value 905 DO jj = 2, jpjm1 906 DO ji = 2,jpim1 907 IF( tmask(ji,jj,1) == 1) THEN 908 zmax = MAX(zmax,zdic(ji,jj)) ! find local maximum 909 zmin = MIN(zmin,zdic(ji,jj)) ! find local minimum 910 ENDIF 911 END DO 912 END DO 913 IF( lk_mpp ) CALL mpp_max( zmax ) ! max over the global domain 914 IF( lk_mpp ) CALL mpp_min( zmin ) ! min over the global domain 915 ! 916 IF( zmax .GT. 4.0E3) THEN ! we've got a problem 917 IF (lk_mpp) THEN 918 CALL mpp_maxloc ( zdic(:,:),tmask(:,:,1), zmax, ii,ij ) 919 ELSE 920 ilocs = MAXLOC( zdic(:,:), mask = tmask(:,:,1) == 1. ) 921 ii = ilocs(1) + nimpp - 1 922 ij = ilocs(2) + njmpp - 1 923 ENDIF 924 ! 925 IF(lwp) THEN 926 WRITE(numout,*) 'trc_bio:tracer anomaly: ***** WARNING *****' 927 WRITE(numout,*) 'trc_bio:tracer anomaly: DIC concentration > 4000 ' 928 WRITE(numout,9600) kt, zmax, ii, ij, jk 929 WRITE(numout,*) 'trc_bio:tracer anomaly: ***** END OF WARNING *****' 930 ENDIF 931 ENDIF 932 ! 933 IF( zmin .LE. 0.0) THEN ! we've got a problem 934 IF (lk_mpp) THEN 935 CALL mpp_minloc ( zdic(:,:),tmask(:,:,1), zmin, ii,ij ) 936 ELSE 937 ilocs = MINLOC( zdic(:,:), mask = tmask(:,:,1) == 1. ) 938 ii = ilocs(1) + nimpp - 1 939 ij = ilocs(2) + njmpp - 1 940 ENDIF 941 ! 942 IF(lwp) THEN 943 WRITE(numout,*) 'trc_bio:tracer anomaly: ***** WARNING *****' 944 WRITE(numout,*) 'trc_bio:tracer anomaly: DIC concentration <= 0 ' 945 WRITE(numout,9700) kt, zmin, ii, ij, jk 946 WRITE(numout,*) 'trc_bio:tracer anomaly: ***** END OF WARNING *****' 947 ENDIF 948 ENDIF 949 !! 950 !!========================== 951 !! ALKALINITY Check 952 zmax = -5.0 ! arbitrary low maximum value 953 zmin = 4.0E4 ! arbitrary high minimum value 954 DO jj = 2, jpjm1 955 DO ji = 2,jpim1 956 IF( tmask(ji,jj,1) == 1) THEN 957 zmax = MAX(zmax,zalk(ji,jj)) ! find local maximum 958 zmin = MIN(zmin,zalk(ji,jj)) ! find local minimum 959 ENDIF 960 END DO 961 END DO 962 IF( lk_mpp ) CALL mpp_max( zmax ) ! max over the global domain 963 IF( lk_mpp ) CALL mpp_min( zmin ) ! min over the global domain 964 ! 965 IF( zmax .GT. 4.0E3) THEN ! we've got a problem 966 IF (lk_mpp) THEN 967 CALL mpp_maxloc ( zalk(:,:),tmask(:,:,1), zmax, ii,ij ) 968 ELSE 969 ilocs = MAXLOC( zalk(:,:), mask = tmask(:,:,1) == 1. ) 970 ii = ilocs(1) + nimpp - 1 971 ij = ilocs(2) + njmpp - 1 972 ENDIF 973 ! 974 IF(lwp) THEN 975 WRITE(numout,*) 'trc_bio:tracer anomaly: ***** WARNING *****' 976 WRITE(numout,*) 'trc_bio:tracer anomaly: ALK concentration > 4000 ' 977 WRITE(numout,9800) kt, zmax, ii, ij, jk 978 WRITE(numout,*) 'trc_bio:tracer anomaly: ***** END OF WARNING *****' 979 ENDIF 980 ENDIF 981 ! 982 IF( zmin .LE. 0.0) THEN ! we've got a problem 983 IF (lk_mpp) THEN 984 CALL mpp_minloc ( zalk(:,:),tmask(:,:,1), zmin, ii,ij ) 985 ELSE 986 ilocs = MINLOC( zalk(:,:), mask = tmask(:,:,1) == 1. ) 987 ii = ilocs(1) + nimpp - 1 988 ij = ilocs(2) + njmpp - 1 989 ENDIF 990 ! 991 IF(lwp) THEN 992 WRITE(numout,*) 'trc_bio:tracer anomaly: ***** WARNING *****' 993 WRITE(numout,*) 'trc_bio:tracer anomaly: ALK concentration <= 0 ' 994 WRITE(numout,9900) kt, zmin, ii, ij, jk 995 WRITE(numout,*) 'trc_bio:tracer anomaly: ***** END OF WARNING *****' 996 ENDIF 997 ENDIF 998 999 1000 9600 FORMAT ('trc_bio:tracer anomaly: kt=',i6,' max DIC: ',f16.10,', i j k: ',3i5) 1001 9700 FORMAT ('trc_bio:tracer anomaly: kt=',i6,' min DIC: ',f16.10,', i j k: ',3i5) 1002 9800 FORMAT ('trc_bio:tracer anomaly: kt=',i6,' max ALK: ',f16.10,', i j k: ',3i5) 1003 9900 FORMAT ('trc_bio:tracer anomaly: kt=',i6,' min ALK: ',f16.10,', i j k: ',3i5) 1004 1005 END SUBROUTINE trc_bio_check 1006 1007 659 1008 #else 660 1009 !!===================================================================== … … 663 1012 CONTAINS 664 1013 SUBROUTINE trc_bio_medusa( kt ) ! Empty routine 1014 IMPLICIT NONE 665 1015 INTEGER, INTENT( in ) :: kt 666 1016 WRITE(*,*) 'trc_bio_medusa: You should not have seen this print! error?', kt -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcdms_medusa.F90
r8132 r10302 113 113 ! 114 114 ! AXY (13/03/15): Anderson et al. (2001) 115 !! JPALM --19-12-2017-- Tunable through the namelist 116 !! within dmsmin - dmscut - dmsslp 115 117 Jterm = xqsr + 1.0e-6 116 118 !! this next line makes a hard-coded assumption about the … … 120 122 Qterm = xdin / (xdin + 0.5) 121 123 fq1 = log10(CHL * Jterm * Qterm) 122 if (fq1 > 1.72) then123 dms_andr = ( 8.24 * (fq1 - 1.72)) + 2.29124 else 125 dms_andr = 2.29124 if (fq1 > dmscut) then 125 dms_andr = (dmsslp * (fq1 - dmscut)) + dmsmin 126 else 127 dms_andr = dmsmin 126 128 endif 127 129 ! -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcini_medusa.F90
r8147 r10302 271 271 zn_dms_srf(:,:) = 0.0 272 272 za_dms_srf(:,:) = 0.0 273 zn_chl_srf(:,:) = 2.0E-8 !! Chl srf273 zn_chl_srf(:,:) = 2.0E-8 !! Chl cpl - set first as surf 274 274 !! 275 275 IF(lwp) WRITE(numout,*) ' trc_ini_medusa: DMS and CO2 flux (UKESM) initialised to zero' … … 278 278 CO2Flux_out_cpl(:,:) = zn_co2_flx(:,:) !! Coupling variable 279 279 DMS_out_cpl(:,:) = zn_dms_srf(:,:) !! Coupling variable 280 chloro_out_cpl(:,:) = zn_chl_srf(:,:) !! Coupling variable280 chloro_out_cpl(:,:) = zn_chl_srf(:,:) * scl_chl !! Coupling variable 281 281 END IF 282 282 !! … … 324 324 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 325 325 IF(lwp) CALL flush(numout) 326 !! 327 !!---------------------------------------------------------------------- 328 !! JPALM (23-01-2017): new way to initialize CO2-atm for cmip6 329 !! initially done in trcsms_medusa 330 !!---------------------------------------------------------------------- 331 !! 332 IF( ( .NOT.lk_oasis ) .AND. ( .NOT.lk_pi_co2 ) .AND. ( xobs_xco2a <= 0.0 ) ) THEN 333 IF(lwp) WRITE(numout,*) ' trc_ini_medusa: initialisating atm CO2 record' 334 CALL trc_ini_medusa_co2atm 335 ENDIF 326 336 327 337 END SUBROUTINE trc_ini_medusa … … 480 490 END SUBROUTINE trc_ini_medusa_river 481 491 492 SUBROUTINE trc_ini_medusa_co2atm 493 !!---------------------------------------------------------------------- 494 !! *** trc_ini_medusa_co2atm *** 495 !! 496 !! ** Purpose : initialization atmospheric co2 record 497 !! 498 !! ** Method : - Read the xco2 file 499 !!---------------------------------------------------------------------- 500 INTEGER :: jn, jm, io, ierr, inum, iostatus 501 INTEGER, PARAMETER :: iskip = 4 ! number of 1st descriptor lines 502 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: zyy !: xCO2 record years 503 CHARACTER (len=10), PARAMETER :: clname = 'xco2.atm' !! atm CO2 record file 504 !!---------------------------------------------------------------------- 505 506 IF(lwp) WRITE(numout,*) 507 IF(lwp) WRITE(numout,*) ' trc_ini_medusa_co2atm: initialisation of atm CO2 historical record' 508 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~' 509 510 511 IF(lwp) WRITE(numout,*) 'read of formatted file xco2.atm' 512 513 CALL ctl_opn( inum, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 514 !!! 515 ! -Compute the number of year in the file 516 ! -File starts in co2_yinit, jn represents the record number in the file. 517 ! -Remove the file head (iskip lines) to jn 518 ! -The year is jn + yinit - 1 519 !! Determine the number of lines in xCO2 input file 520 iostatus = 0 521 jn = 1 522 DO WHILE ( iostatus == 0 ) 523 READ(inum,'(1x)', IOSTAT=iostatus, END=100) 524 jn = jn + 1 525 ENDDO 526 IF( iostatus .NE. 0 ) THEN 527 !! Error while reading xCO2 input file 528 CALL ctl_stop('trc_ini_medusa_co2atm: & 529 & Error on the 1st reading of xco2.atm') 530 RETURN 531 ENDIF 532 100 co2_rec = jn - 1 - iskip 533 IF ( lwp) WRITE(numout,*) ' ', co2_rec ,' years read in the file' 534 ! ! Allocate CO2 hist arrays 535 ierr = 0 536 ALLOCATE( hist_pco2(co2_rec),zyy(co2_rec), STAT=ierr ) 537 IF( ierr > 0 ) THEN 538 CALL ctl_stop( 'trc_ini_medusa_co2atm: unable to allocate array' ) 539 RETURN 540 ENDIF 541 542 REWIND(inum) 543 544 DO jm = 1, iskip ! Skip over 1st six descriptor lines 545 READ(inum,'(1x)') 546 END DO 547 ! file starts in 1931 do jn represent the year in the century.jhh 548 ! Read file till the end 549 ! allocate start and end year of the file 550 DO jn = 1, co2_rec 551 READ(inum,'(F6.1,F12.7)', IOSTAT=io) zyy(jn), hist_pco2(jn) 552 IF( io .NE. 0 ) THEN 553 !! Error while reading xCO2 input file 554 CALL ctl_stop('trc_ini_medusa_co2atm: & 555 & Error on the 2nd reading of xco2.atm') 556 RETURN 557 ENDIF 558 559 IF(jn==1) co2_yinit = zyy(jn) 560 END DO 561 co2_yend = co2_yinit + real(co2_rec) - 1. 562 563 IF(lwp) THEN ! Control print 564 WRITE(numout,*) 565 WRITE(numout,*) 'CO2 hist start year: ', co2_yinit 566 WRITE(numout,*) 'CO2 hist end year: ', co2_yend 567 WRITE(numout,*) ' Year xCO2 atm ' 568 DO jn = 1, co2_rec 569 WRITE(numout, '(F6.1,F12.7)') zyy(jn), hist_pco2(jn) 570 END DO 571 ENDIF 572 573 END SUBROUTINE trc_ini_medusa_co2atm 574 575 482 576 #else 483 577 !!---------------------------------------------------------------------- -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcnam_medusa.F90
r8442 r10302 24 24 USE sms_medusa ! sms trends 25 25 USE iom ! I/O manager 26 USE sbc_oce, ONLY: lk_oasis 26 27 !!USE trc_nam_dia ! JPALM 13-11-2015 -- if iom_use for diag 27 28 … … 85 86 & jriver_n,jriver_si,jriver_c,jriver_alk,jriver_dep, & 86 87 & xsdiss, & 87 & sedlam,sedlostpoc,jpkb,jdms,jdms_input,jdms_model 88 & sedlam,sedlostpoc,jpkb,jdms,jdms_input,jdms_model, & 89 & scl_chl, chl_out, dmsmin, dmscut, dmsslp, & 90 & ln_foam_medusa 88 91 #if defined key_roam 89 92 NAMELIST/natroam/ xthetaphy,xthetazoo,xthetanit, & 93 & xobs_xco2a, & 90 94 & xthetarem,xo2min 91 95 #endif … … 125 129 ! 1.4 namelist natbio : biological parameters 126 130 ! ------------------------------------------- 131 !! Note: the default values below will all be overwritten by the 132 !! input in the namelist natbio. 127 133 128 134 xxi = 0. … … 246 252 jdms_input = 0 247 253 jdms_model = 0 254 scl_chl = 1. 255 chl_out = 1 256 dmsmin = 2.29 !! Anderson DMS default 257 dmscut = 1.72 !! Anderson DMS default 258 dmsslp = 8.24 !! Anderson DMS default 259 !! 260 ln_foam_medusa = .FALSE. 248 261 249 262 !REWIND(numnatm) … … 399 412 !! jdms_model : choice of DMS model passed to atmosphere 400 413 !! 1 = ANDR, 2 = SIMO, 3 = ARAN, 4 = HALL, 5 = ANDM 401 !! 414 !! dmsmin : DMS minimum value for DMS Anderson (ANDR) sheme ONLY 415 !! dmscut : DMS cutoff value for DMS Anderson (ANDR) sheme ONLY 416 !! dmsslp : DMS slope value for DMS Anderson (ANDR) sheme ONLY 417 !! UKESM1 - exported Chl to UM 418 !! scl_chl : scaling factor to tune the chl field sent to the UM 419 !! chl_out : select the chl field to send at the UM: 420 !! 1- Surf Chl ; 2- MLD Chl 421 !! 422 !! FOAM - observation operator and data assimilation 423 !! ln_foam_medusa : calculate required diagnostics 424 402 425 IF(lwp) THEN 403 426 !! … … 909 932 !! 910 933 !! UKESM1 - new diagnostics !! Jpalm; AXY (08/07/15) 911 WRITE(numout,*) '=== UKESM1-related parameters' 912 WRITE(numout,*) & 913 & ' include DMS diagnostic?, jdms = ', jdms 914 if (jdms_input .eq. 0) then 915 WRITE(numout,*) & 916 & ' use instant (0) or diel-avg (1) inputs, jdms_input = instantaneous' 917 else 918 WRITE(numout,*) & 919 & ' use instant (0) or diel-avg (1) inputs, jdms_input = diel-average' 920 endif 921 if (jdms_model .eq. 1) then 922 WRITE(numout,*) & 923 & ' choice of DMS model passed to atmosphere, jdms_model = Anderson et al. (2001)' 924 elseif (jdms_model .eq. 2) then 925 WRITE(numout,*) & 926 & ' choice of DMS model passed to atmosphere, jdms_model = Simo & Dachs (2002)' 927 elseif (jdms_model .eq. 3) then 928 WRITE(numout,*) & 929 & ' choice of DMS model passed to atmosphere, jdms_model = Aranami & Tsunogai (2004)' 930 elseif (jdms_model .eq. 4) then 931 WRITE(numout,*) & 932 & ' choice of DMS model passed to atmosphere, jdms_model = Halloran et al. (2010)' 933 elseif (jdms_model .eq. 5) then 934 WRITE(numout,*) & 935 & ' choice of DMS model passed to atmosphere, jdms_model = Anderson et al. (2001; modified)' 936 endif 934 WRITE(numout,*) '=== UKESM1-related parameters ===' 935 WRITE(numout,*) ' ---- --- ---' 936 937 IF (lk_oasis) THEN 938 WRITE(numout,*) '=== UKESM1 -- coupled DMS to the atmosphere' 939 WRITE(numout,*) & 940 & ' include DMS diagnostic?, jdms = ', jdms 941 if (jdms_input .eq. 0) then 942 WRITE(numout,*) & 943 & ' use instant (0) or diel-avg (1) inputs, jdms_input = instantaneous' 944 else 945 WRITE(numout,*) & 946 & ' use instant (0) or diel-avg (1) inputs, jdms_input = diel-average' 947 endif 948 if (jdms_model .eq. 1) then 949 WRITE(numout,*) & 950 & ' choice of DMS model passed to atmosphere, jdms_model = Anderson et al. (2001)' 951 elseif (jdms_model .eq. 2) then 952 WRITE(numout,*) & 953 & ' choice of DMS model passed to atmosphere, jdms_model = Simo & Dachs (2002)' 954 elseif (jdms_model .eq. 3) then 955 WRITE(numout,*) & 956 & ' choice of DMS model passed to atmosphere, jdms_model = Aranami & Tsunogai (2004)' 957 elseif (jdms_model .eq. 4) then 958 WRITE(numout,*) & 959 & ' choice of DMS model passed to atmosphere, jdms_model = Halloran et al. (2010)' 960 elseif (jdms_model .eq. 5) then 961 WRITE(numout,*) & 962 & ' choice of DMS model passed to atmosphere, jdms_model = Anderson et al. (2001; modified)' 963 endif 964 if (jdms_model .eq. 1) then 965 WRITE(numout,*) & 966 & ' Anderson DMS model tuned parameters: DMS minimum = ',dmsmin,'. -- Default = 2.29 ' 967 WRITE(numout,*) & 968 & ' Anderson DMS model tuned parameters: DMS cutoff = ',dmscut,'. -- Default = 1.72 ' 969 WRITE(numout,*) & 970 & ' Anderson DMS model tuned parameters: DMS slope = ',dmsslp,'. -- Default = 8.24 ' 971 endif 972 973 WRITE(numout,*) '=== UKESM1 -- coupled Chl to the atmosphere' 974 WRITE(numout,*) & 975 & ' Scaling factor to export tuned Chl to the atmosphere scl_chl = ', scl_chl 976 IF (chl_out .eq. 1) THEN 977 WRITE(numout,*) & 978 & ' Chl field to be scaled and sent to the atmosphere: chl_out = Surface Chl field ' 979 ELSEIF (chl_out .eq. 2) THEN 980 WRITE(numout,*) & 981 & ' Chl field to be scaled and sent to the atmosphere: chl_out = MLD Chl field ' 982 ENDIF 983 ENDIF ! IF lk_oasis=true 984 !! FOAM 985 WRITE(numout,*) '=== FOAM-related parameters' 986 WRITE(numout,*) & 987 & ' calculate diagnostics for data assimilation, ln_foam_medusa = ', ln_foam_medusa 937 988 !! 938 989 ENDIF … … 990 1041 xthetarem = 0. 991 1042 xo2min = 0. 1043 xobs_xco2a = 0. 992 1044 993 1045 !READ(numnatm,natroam) … … 1009 1061 !! xthetarem : oxygen consumption by carbon remineralisation 1010 1062 !! xo2min : oxygen minimum concentration 1063 !! xobs_xco2a : observed atmospheric xCO2 (not used if <= 0) 1011 1064 1012 1065 IF(lwp) THEN … … 1026 1079 WRITE(numout,*) & 1027 1080 & ' oxygen minimum concentration xo2min = ', xo2min 1081 WRITE(numout,*) & 1082 & ' observed atmospheric xCO2 (not used if <= 0) xobs_xco2a = ', xobs_xco2a 1028 1083 ENDIF 1029 1084 … … 2053 2108 med_diag%OCN_DPCO2%dgsave = .FALSE. 2054 2109 ENDIF 2055 !! 2110 !! UKESM additional 2111 IF (iom_use("CHL_MLD")) THEN 2112 med_diag%CHL_MLD%dgsave = .TRUE. 2113 ELSE 2114 med_diag%CHL_MLD%dgsave = .FALSE. 2115 ENDIF 2116 IF (iom_use("CHL_CPL")) THEN 2117 med_diag%CHL_CPL%dgsave = .TRUE. 2118 ELSE 2119 med_diag%CHL_CPL%dgsave = .FALSE. 2120 ENDIF 2121 !! 3D 2056 2122 IF (iom_use("TPP3")) THEN 2057 2123 med_diag%TPP3%dgsave = .TRUE. -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcsms_medusa.F90
r8074 r10302 8 8 !! - ! 2008-11 (A. Yool) continuing adaptation for MEDUSA 9 9 !! - ! 2010-03 (A. Yool) updated for branch inclusion 10 !! - ! 2017-08 (A. Yool) amend for slow detritus bug 10 11 !!---------------------------------------------------------------------- 11 12 #if defined key_medusa … … 22 23 USE trcsed_medusa 23 24 USE trcavg_medusa 25 !! for SMS trends 26 USE par_medusa, ONLY: jp_msa0, jp_msa1, jp_medusa 27 USE par_oce, ONLY: jpi, jpj, jpk 28 USE trd_oce, ONLY: jptra_sms, l_trdtrc 29 USE trdtrc 24 30 25 31 … … 46 52 !!---------------------------------------------------------------------- 47 53 INTEGER, INTENT(in) :: kt ! ocean time-step index 54 !! Loop variables 55 INTEGER :: jn 56 !! trend temporary array: 57 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrmed 58 48 59 49 60 # if defined key_debug_medusa … … 57 68 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 58 69 ENDIF 70 71 !! MEDUSA SMS trends: 72 IF( l_trdtrc ) THEN 73 CALL wrk_alloc( jpi, jpj, jpk, jp_medusa, ztrmed ) 74 ztrmed(:,:,:,:)=0.0 75 DO jn = 1, jp_medusa 76 ztrmed(:,:,:,jn) = tra(:,:,:,jp_msa0 + jn - 1) 77 END DO 78 END IF 59 79 60 80 CALL trc_avg_medusa( kt ) ! rolling average module … … 88 108 # endif 89 109 90 CALL trc_sed_medusa( kt ) ! sedimentation model 91 # if defined key_debug_medusa 92 IF(lwp) WRITE(numout,*) ' MEDUSA done trc_sed_medusa' 93 CALL flush(numout) 94 # endif 110 !! AXY (08/08/2017): remove call to buggy subroutine (now handled by detritus.F90) 111 !! CALL trc_sed_medusa( kt ) ! sedimentation model 112 !! # if defined key_debug_medusa 113 !! IF(lwp) WRITE(numout,*) ' MEDUSA done trc_sed_medusa' 114 !! CALL flush(numout) 115 !! # endif 95 116 # endif 117 118 !! MEDUSA SMS trends: 119 IF( l_trdtrc ) THEN 120 DO jn = 1, jp_medusa 121 ztrmed(:,:,:,jn) = tra(:,:,:,jp_msa0 + jn - 1)-ztrmed(:,:,:,jn) 122 CALL trd_trc( ztrmed(:,:,:,jn), jn, jptra_sms, kt ) ! save trends 123 END DO 124 CALL wrk_dealloc( jpi, jpj, jpk, jp_medusa, ztrmed ) 125 END IF 126 96 127 97 128 END SUBROUTINE trc_sms_medusa -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/MEDUSA/zooplankton.F90
r8441 r10302 41 41 idf, idfval, & 42 42 zdet, zdtc, zphd, zphn, zzme, zzmi 43 USE dom_oce, ONLY: e3t_0, e3t_n, tmask 43 USE dom_oce, ONLY: e3t_0, tmask 44 #if defined key_vvl 45 USE dom_oce, ONLY: e3t_n 46 #endif 44 47 USE par_kind, ONLY: wp 45 48 USE in_out_manager, ONLY: lwp, numout -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90
r7771 r10302 51 51 !! 52 52 !!---------------------------------------------------------------------- 53 IMPLICIT NONE 53 54 INTEGER, INTENT( in ) :: kt ! ocean time-step 54 55 CHARACTER (len=22) :: charout 55 56 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztrtrd 57 INTEGER :: jn ! Local loop index 56 58 !!---------------------------------------------------------------------- 57 59 ! … … 108 110 CONTAINS 109 111 SUBROUTINE trc_bbl( kt ) ! Empty routine 112 IMPLICIT NONE 113 INTEGER, INTENT(in) :: kt ! ocean time-step index 110 114 WRITE(*,*) 'tra_bbl: You should not have seen this print! error?', kt 111 115 END SUBROUTINE trc_bbl -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90
r6487 r10302 27 27 !!---------------------------------------------------------------------- 28 28 USE oce_trc ! ocean dynamics and tracers variables 29 USE domvvl ! variable volume 29 30 USE trc ! ocean passive tracers variables 30 31 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 31 32 USE prtctl_trc ! Print control for debbuging 33 USE trcnam_trp ! passive tracers transport namelist variables 32 34 USE trd_oce 33 35 USE trdtra … … 45 47 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: r2dt 46 48 49 !! * Substitutions 50 # include "domzgr_substitute.h90" 47 51 !!---------------------------------------------------------------------- 48 52 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 124 128 IF( l_trdtrc ) THEN 125 129 CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrdt ) !* store now fields before applying the Asselin filter 126 ztrdt(:,:,:,:) = trn(:,:,:,:) 130 ztrdt(:,:,jpk,:) = 0._wp 131 IF( ln_trcldf_iso ) THEN ! diagnose the "pure" Kz diffusive trend 132 DO jn = 1, jptra 133 CALL trd_tra( kt, 'TRC', jn, jptra_zdfp, ztrdt(:,:,:,jn) ) 134 ENDDO 135 ENDIF 136 ! total trend for the non-time-filtered variables. 137 ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn 138 ! cancel from tsn terms 139 IF( lk_vvl ) THEN 140 DO jn = 1, jptra 141 DO jk = 1, jpkm1 142 zfact = 1.0 / rdttrc(jk) 143 ztrdt(:,:,jk,jn) = ( tra(:,:,jk,jn)*fse3t_a(:,:,jk) / fse3t_n(:,:,jk) - & 144 trn(:,:,jk,jn) ) * zfact 145 END DO 146 END DO 147 ELSE 148 DO jn = 1, jptra 149 DO jk = 1, jpkm1 150 zfact = 1.0 / rdttrc(jk) 151 ztrdt(:,:,jk,jn) = ( tra(:,:,jk,jn) - trn(:,:,jk,jn) ) * zfact 152 END DO 153 END DO 154 END IF 155 DO jn = 1, jptra 156 CALL trd_tra( kt, 'TRC', jn, jptra_tot, ztrdt(:,:,:,jn) ) 157 ENDDO 158 IF( .NOT.lk_vvl ) THEN 159 ! Store now fields before applying the Asselin filter 160 ! in order to calculate Asselin filter trend later. 161 ztrdt(:,:,:,:) = trn(:,:,:,:) 162 ENDIF 127 163 ENDIF 128 164 ! Leap-Frog + Asselin filter time stepping … … 134 170 END DO 135 171 END DO 172 IF (l_trdtrc.AND.lk_vvl) THEN ! Zero Asselin filter contribution 173 ! must be explicitly written out since for vvl 174 ! Asselin filter is output by 175 ! tra_nxt_vvl that is not called on 176 ! this time step 177 ztrdt(:,:,:,:) = 0._wp 178 DO jn = 1, jptra 179 CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt(:,:,:,jn) ) 180 ENDDO 181 END IF 182 136 183 ! 137 184 ELSE … … 144 191 145 192 ! trends computation 146 IF( l_trdtrc 193 IF( l_trdtrc.AND..NOT.lk_vvl) THEN ! trends 147 194 DO jn = 1, jptra 148 195 DO jk = 1, jpkm1 149 196 zfact = 1.e0 / r2dt(jk) 150 197 ztrdt(:,:,jk,jn) = ( trb(:,:,jk,jn) - ztrdt(:,:,jk,jn) ) * zfact 151 CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt )152 END DO198 END DO 199 CALL trd_tra( kt, 'TRC', jn, jptra_atf, ztrdt(:,:,:,jn) ) 153 200 END DO 154 CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrdt )155 201 END IF 202 ! 203 IF( l_trdtrc) CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrdt ) 156 204 ! 157 205 IF(ln_ctl) THEN ! print mean trends (used for debugging) -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
r8356 r10302 140 140 DO jn = 1, jptra 141 141 ! 142 IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn) ! save trends 143 ! ! add the trend to the general tracer trend 142 IF( l_trdtrc ) THEN 143 ztrtrd(:,:,:) = 0.0 144 ztrtrd(:,:,1) = tra(:,:,1,jn) ! save surface trends 145 ! ! add the trend to the general tracer trend 146 ENDIF 144 147 145 148 IF ( nn_ice_tr == -1 ) THEN ! No tracers in sea ice (null concentration in sea ice) … … 184 187 ! 185 188 IF( l_trdtrc ) THEN 186 ztrtrd(:,:, :) = tra(:,:,:,jn) - ztrtrd(:,:,:)189 ztrtrd(:,:,1) = tra(:,:,1,jn) - ztrtrd(:,:,1) 187 190 CALL trd_tra( kt, 'TRC', jn, jptra_nsr, ztrtrd ) 188 191 END IF -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90
r8442 r10302 28 28 USE zpshde ! partial step: hor. derivative (zps_hde routine) 29 29 # if defined key_debug_medusa 30 USE trc rst30 USE trcstat 31 31 # endif 32 32 -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90
r6486 r10302 15 15 !!---------------------------------------------------------------------- 16 16 USE oce_trc ! ocean dynamics and active tracers 17 USE domvvl ! variable volume 17 18 USE trc ! ocean passive tracers variables 18 19 USE trcnam_trp ! passive tracers transport namelist variables … … 98 99 99 100 IF( l_trdtrc ) THEN ! save the vertical diffusive trends for further diagnostics 101 !! JPALM -- 18-08-2017 -- vvl case, do as done by G Nurser in trazdf 102 IF( lk_vvl ) THEN 103 DO jn = 1, jptra 104 DO jk = 1, jpkm1 105 ztrtrd(:,:,jk,jn) = ( ( tra(:,:,jk,jn)*fse3t_a(:,:,jk) - & 106 trb(:,:,jk,jn)*fse3t_b(:,:,jk) ) & 107 / (fse3t_n(:,:,jk)*r2dt(jk)) ) - ztrtrd(:,:,jk,jn) 108 END DO 109 END DO 110 ELSE 111 DO jn = 1, jptra 112 DO jk = 1, jpkm1 113 ztrtrd(:,:,jk,jn) = ( ( tra(:,:,jk,jn) - trb(:,:,jk,jn) ) / r2dt(jk) ) - ztrtrd(:,:,jk,jn) 114 END DO 115 END DO 116 ENDIF 100 117 DO jn = 1, jptra 101 DO jk = 1, jpkm1102 ztrtrd(:,:,jk,jn) = ( ( tra(:,:,jk,jn) - trb(:,:,jk,jn) ) / r2dt(jk) ) - ztrtrd(:,:,jk,jn)103 END DO104 118 CALL trd_tra( kt, 'TRC', jn, jptra_zdf, ztrtrd(:,:,:,jn) ) 105 119 END DO -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc.F90
r6486 r10302 19 19 USE trdmxl_trc ! Mixed layer trends diag. 20 20 USE iom ! I/O library 21 # if defined key_debug_medusa 22 USE trcstat, ONLY: trc_rst_dia_stat 23 # endif 21 24 22 25 IMPLICIT NONE … … 86 89 87 90 IF( lk_trdtrc .AND. ln_trdtrc( kjn ) ) THEN 88 ! 91 !! JPALM -- 17-08-2017 -- modif following trd_tra_iom as suggested by Georges 92 !! -- add jptra_tot; jptra_totad; jptra_zdfp 93 !! -- shange to output trends every 2 time-step, except tot. 94 !! -- move cltra and iomput inside the select case 95 !! So if an non-wanted case arrives here it will not go 96 !! through cltra (without value) and break iomput. 97 !! -- Add iom_use in prevision of not using All trends 98 !! for All passive tracers (will create a HUGE 3D file otherwise -- 99 !! might be interested in very few of them : SMS and TOT probably) 100 ! 101 SELECT CASE( ktrd ) 102 !! tot - output every time-step: 103 CASE( jptra_tot ) ; WRITE (cltra,'("TOT_",4a)') 104 cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 105 CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt ) 106 END SELECT 107 ! 108 IF( MOD( kt, 2 ) == 0 ) THEN 89 109 SELECT CASE( ktrd ) 90 110 CASE( jptra_xad ) ; WRITE (cltra,'("XAD_",4a)') 111 cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 112 CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt ) 91 113 CASE( jptra_yad ) ; WRITE (cltra,'("YAD_",4a)') 92 CASE( jptra_zad ) ; WRITE (cltra,'("ZAD_",4a)') 114 cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 115 CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt ) 116 CASE( jptra_zad ) ; WRITE (cltra,'("ZAD_",4a)') !! care vvl case 117 cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 118 CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt ) 119 CASE( jptra_totad ) ; WRITE (cltra,'("TAD_",4a)') !! total adv 120 cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 121 CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt ) 93 122 CASE( jptra_ldf ) ; WRITE (cltra,'("LDF_",4a)') 123 cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 124 CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt ) 94 125 CASE( jptra_bbl ) ; WRITE (cltra,'("BBL_",4a)') 126 cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 127 CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt ) 95 128 CASE( jptra_nsr ) ; WRITE (cltra,'("FOR_",4a)') 129 cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 130 CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt ) 96 131 CASE( jptra_zdf ) ; WRITE (cltra,'("ZDF_",4a)') 132 cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 133 CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt ) 134 CASE( jptra_zdfp ) ; WRITE (cltra,'("ZDP_",4a)') 135 cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 136 CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt ) 97 137 CASE( jptra_dmp ) ; WRITE (cltra,'("DMP_",4a)') 138 cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 139 CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt ) 98 140 CASE( jptra_sms ) ; WRITE (cltra,'("SMS_",4a)') 141 cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 142 CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt ) 143 CASE( jptra_radb ) ; WRITE (cltra,'("RDB_",4a)') 144 cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 145 CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt ) 146 CASE( jptra_radn ) ; WRITE (cltra,'("RDN_",4a)') 147 cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 148 CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt ) 149 END SELECT 150 ELSE IF( MOD( kt, 2 ) == 1 ) THEN 151 SELECT CASE( ktrd ) 99 152 CASE( jptra_atf ) ; WRITE (cltra,'("ATF_",4a)') 100 CASE( jptra_radb ) ; WRITE (cltra,'("RDB_",4a)') 101 CASE( jptra_radn ) ; WRITE (cltra,'("RDN_",4a)') 102 END SELECT 103 cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 104 CALL iom_put( cltra, ptrtrd(:,:,:) ) 153 cltra = TRIM(cltra)//TRIM(ctrcnm(kjn)) 154 CALL trd_trc_iomput( cltra, ptrtrd, kjn, kt ) 155 END SELECT 156 END IF 105 157 ! 106 158 END IF … … 123 175 124 176 END SUBROUTINE trd_trc_bio 177 178 SUBROUTINE trd_trc_iomput( cltra, ptrtrd, kjn, kt ) 179 !!---------------------------------------------------------------------- 180 !! *** ROUTINE trd_trc_iomput *** 181 !!---------------------------------------------------------------------- 182 INTEGER, INTENT( in ) :: kt ! timestep 183 INTEGER, INTENT( in ) :: kjn ! biotrend index 184 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) :: ptrtrd ! var trend 185 CHARACTER (len=*),INTENT( in ) :: cltra ! trend name 186 !!---------------------------------------------------------------------- 187 188 189 IF (iom_use(cltra)) THEN 190 # if defined key_debug_medusa 191 IF(lwp) WRITE(numout,*) ' TREND stats (min, max,sum) kt = ',kt ,' jn = ',kjn 192 CALL trc_rst_dia_stat( ptrtrd(:,:,1), cltra) 193 # endif 194 CALL iom_put( cltra, ptrtrd(:,:,:) ) 195 # if defined key_debug_medusa 196 ELSE 197 IF(lwp) WRITE(numout,*) & 198 ' TREND -- No output asked for ',cltra,' kt = ',kt,' jn = ',kjn 199 CALL trc_rst_dia_stat( ptrtrd(:,:,1), cltra) 200 # endif 201 ENDIF 202 203 END SUBROUTINE trd_trc_iomput 204 205 125 206 #else 126 207 !!---------------------------------------------------------------------- -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/trc.F90
r8280 r10302 33 33 !! -------------------------------------------------- 34 34 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: trai !: initial total tracer 35 # if defined key_medusa && key_roam 36 !! AXY (17/11/2017): elemental cycle initial totals 37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: cycletot !: initial elemental cycle total 38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: cycletot2 !: initial elemental cycle total excl. halo in mpp_sum 39 # endif 35 40 REAL(wp), PUBLIC :: areatot !: total volume 36 41 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,: ) :: cvol !: volume correction -degrad option- … … 105 110 END TYPE DIAG 106 111 107 #if defined key_medusa && defined key_iomput112 #if defined key_medusa 108 113 TYPE, PUBLIC :: BDIAG 109 114 LOGICAL :: dgsave … … 134 139 OCN_KWCO2, OCN_K0, CO2STARAIR, OCN_DPCO2, & ! end of regular 2D 135 140 TPP3, DETFLUX3, REMIN3N, PH3, OM_CAL3, & ! end of regular 3D 141 ! JPALM (01/09/17): additional UKESM 2D diag 142 CHL_MLD, CHL_CPL, & 136 143 ! AXY (11/11/16): additional CMIP6 2D diagnostics 137 144 epC100, epCALC100, epN100, epSI100, & … … 264 271 & cvol(jpi,jpj,jpk) , rdttrc(jpk) , trai(jptra) , & 265 272 & ctrcnm(jptra) , ctrcln(jptra) , ctrcun(jptra) , & 273 # if defined key_medusa && defined key_roam 274 & cycletot(6), cycletot2(6) , & 275 # endif 266 276 & ln_trc_ini(jptra) , ln_trc_wri(jptra) , qsr_mean(jpi,jpj) , STAT = trc_alloc ) 267 277 -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r8442 r10302 28 28 USE trcini_idtra ! idealize tracer initialisation 29 29 USE trcini_medusa ! MEDUSA initialisation 30 USE par_medusa ! MEDUSA parameters (needed for elemental cycles) 30 31 USE trcdta ! initialisation from files 31 32 USE daymod ! calendar manager … … 35 36 USE sbc_oce 36 37 USE trcice ! tracers in sea ice 37 38 # if defined key_medusa 39 USE sms_medusa ! MEDUSA initialisation 40 # endif 38 41 IMPLICIT NONE 39 42 PRIVATE … … 62 65 !! or read data or analytical formulation 63 66 !!--------------------------------------------------------------------- 64 INTEGER :: jk, jn, jl ! dummy loop indices 67 INTEGER :: ji, jj, jk, jn, jl ! dummy loop indices 68 # if defined key_medusa && defined key_roam 69 !! AXY (23/11/2017) 70 REAL(wp) :: zsum3d, zsum2d 71 REAL(wp) :: zq1, zq2, loc_vol, loc_area 72 REAL(wp), DIMENSION(6) :: loc_cycletot3, loc_cycletot2 73 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztot3d 74 REAL(wp), DIMENSION(jpi,jpj) :: ztot2d, carea 75 # endif 65 76 CHARACTER (len=25) :: charout 66 77 !!--------------------------------------------------------------------- … … 98 109 ! ! total volume of the ocean 99 110 areatot = glob_sum( cvol(:,:,:) ) 111 # if defined key_medusa && defined key_roam 112 carea(:,:) = e1e2t(:,:) * tmask(:,:,1) 113 # endif 100 114 101 115 IF( lk_pisces ) CALL trc_ini_pisces ! PISCES bio-model … … 192 206 ENDIF 193 207 194 IF(lwp) WRITE(numout,*) 195 IF(lwp) WRITE(numout,*) 'trc_init : passive tracer set up completed' 196 IF(lwp) WRITE(numout,*) '~~~~~~~' 197 IF(lwp) CALL flush(numout) 208 # if defined key_medusa && defined key_roam 209 ! AXY (17/11/2017): calculate initial totals of elemental cycles 210 ! 211 ! This is done in a very hard-wired way here; in future, this could be 212 ! replaced with loops and using a 2D array; one dimension would cover 213 ! the tracers, the other would be for the elements; each tracer would 214 ! have a factor for each element to say how much of that element was 215 ! in that tracer; for example, PHN would be 1.0 for N, xrfn for Fe and 216 ! xthetapn for C, with the other elements 0.0; the array entry for PHN 217 ! would then be (1. 0. xrfn xthetapn 0. 0.) for (N, Si, Fe, C, A, O2); 218 ! saving this for the next iteration 219 ! 220 cycletot(:) = 0._wp 221 ! report elemental totals at initialisation as we go along 222 IF ( lwp ) WRITE(numout,*) 223 IF ( lwp ) WRITE(numout,*) ' Elemental cycle totals: ' 224 ! nitrogen 225 ztot3d(:,:,:) = trn(:,:,:,jpphn) + trn(:,:,:,jpphd) + trn(:,:,:,jpzmi) + & 226 trn(:,:,:,jpzme) + trn(:,:,:,jpdet) + trn(:,:,:,jpdin) 227 ztot2d(:,:) = zn_sed_n(:,:) 228 zsum3d = glob_sum( ztot3d(:,:,:) * cvol(:,:,:) ) 229 zsum2d = glob_sum( ztot2d(:,:) * carea(:,:) ) 230 cycletot(1) = zsum3d + zsum2d 231 IF ( lwp ) WRITE(numout,9010) 'nitrogen', zsum3d, zsum2d, cycletot(1) 232 ! silicon 233 ztot3d(:,:,:) = trn(:,:,:,jppds) + trn(:,:,:,jpsil) 234 ztot2d(:,:) = zn_sed_si(:,:) 235 zsum3d = glob_sum( ztot3d(:,:,:) * cvol(:,:,:) ) 236 zsum2d = glob_sum( ztot2d(:,:) * carea(:,:) ) 237 cycletot(2) = zsum3d + zsum2d 238 IF ( lwp ) WRITE(numout,9010) 'silicon', zsum3d, zsum2d, cycletot(2) 239 ! iron 240 ztot3d(:,:,:) = ((trn(:,:,:,jpphn) + trn(:,:,:,jpphd) + trn(:,:,:,jpzmi) + & 241 trn(:,:,:,jpzme) + trn(:,:,:,jpdet)) * xrfn) + trn(:,:,:,jpfer) 242 ztot2d(:,:) = zn_sed_fe(:,:) 243 zsum3d = glob_sum( ztot3d(:,:,:) * cvol(:,:,:) ) 244 zsum2d = glob_sum( ztot2d(:,:) * carea(:,:) ) 245 cycletot(3) = zsum3d + zsum2d 246 IF ( lwp ) WRITE(numout,9010) 'iron', zsum3d, zsum2d, cycletot(3) 247 ! carbon (uses fixed C:N ratios on plankton tracers) 248 ztot3d(:,:,:) = (trn(:,:,:,jpphn) * xthetapn) + (trn(:,:,:,jpphd) * xthetapd) + & 249 (trn(:,:,:,jpzmi) * xthetazmi) + (trn(:,:,:,jpzme) * xthetazme) + & 250 trn(:,:,:,jpdtc) + trn(:,:,:,jpdic) 251 ztot2d(:,:) = zn_sed_c(:,:) + zn_sed_ca(:,:) 252 zsum3d = glob_sum( ztot3d(:,:,:) * cvol(:,:,:) ) 253 zsum2d = glob_sum( ztot2d(:,:) * carea(:,:) ) 254 cycletot(4) = zsum3d + zsum2d 255 IF ( lwp ) WRITE(numout,9010) 'carbon', zsum3d, zsum2d, cycletot(4) 256 ! alkalinity (note benthic correction) 257 ztot3d(:,:,:) = trn(:,:,:,jpalk) 258 ztot2d(:,:) = zn_sed_ca(:,:) * 2._wp 259 zsum3d = glob_sum( ztot3d(:,:,:) * cvol(:,:,:) ) 260 zsum2d = glob_sum( ztot2d(:,:) * carea(:,:) ) 261 cycletot(5) = zsum3d + zsum2d 262 IF ( lwp ) WRITE(numout,9010) 'alkalinity', zsum3d, zsum2d, cycletot(5) 263 ! oxygen (note no benthic) 264 ztot3d(:,:,:) = trn(:,:,:,jpoxy) 265 ztot2d(:,:) = 0._wp 266 zsum3d = glob_sum( ztot3d(:,:,:) * cvol(:,:,:) ) 267 zsum2d = glob_sum( ztot2d(:,:) * carea(:,:) ) 268 cycletot(6) = zsum3d + zsum2d 269 IF ( lwp ) WRITE(numout,9010) 'oxygen', zsum3d, zsum2d, cycletot(6) 270 ! Check 271 zsum3d = glob_sum( cvol(:,:,:) ) 272 zsum2d = glob_sum( carea(:,:) ) 273 IF ( lwp ) THEN 274 WRITE(numout,*) 275 WRITE(numout,*) ' check : cvol : ', zsum3d 276 WRITE(numout,*) ' check : carea : ', zsum2d 277 WRITE(numout,*) 278 ENDIF 279 ! 280 # endif 281 282 IF(lwp) THEN 283 WRITE(numout,*) 284 WRITE(numout,*) 'trc_init : passive tracer set up completed' 285 WRITE(numout,*) '~~~~~~~' 286 ENDIF 198 287 # if defined key_debug_medusa 199 288 CALL trc_rst_stat … … 202 291 203 292 9000 FORMAT(' tracer nb : ',i2,' name :',a10,' initial content :',e18.10) 293 9010 FORMAT(' element:',a10, & 294 ' 3d sum:',e18.10,' 2d sum:',e18.10, & 295 ' total:',e18.10) 204 296 ! 205 297 IF( nn_timing == 1 ) CALL timing_stop('trc_init') -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/trcnam.F90
r8442 r10302 60 60 !! ( (PISCES, CFC, MY_TRC, MEDUSA, IDTRA, Age ) 61 61 !!--------------------------------------------------------------------- 62 INTEGER :: jn, jk ! dummy loop indice 62 INTEGER :: ierr 63 #if defined key_trdmxl_trc || defined key_trdtrc 64 NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, & 65 & ln_trdmxl_trc_restart, ln_trdmxl_trc_instant, & 66 & cn_trdrst_trc_in, cn_trdrst_trc_out, ln_trdtrc 67 #endif 68 69 INTEGER :: jn, jk ! dummy loop indice 70 INTEGER :: ios ! Local integer output status for namelist read 71 !!--------------------------------------------------------------------- 72 73 63 74 ! ! Parameters of the run 64 75 IF( .NOT. lk_offline ) CALL trc_nam_run … … 68 79 69 80 ! ! Parameters of additional diagnostics 70 CALL trc_nam_dia81 IF( .NOT. lk_iomput ) CALL trc_nam_dia 71 82 72 83 ! ! namelist of transport … … 171 182 ENDIF 172 183 173 IF( lk_c14b ) THEN; CALL trc_nam_c14b ! C14 bomb tracers174 ELSE 184 IF( lk_c14b ) THEN ; CALL trc_nam_c14b ! C14 bomb tracers 185 ELSE ; IF(lwp) WRITE(numout,*) ' C14 not used' 175 186 ENDIF 176 187 -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
r8427 r10302 30 30 USE daymod 31 31 !! AXY (05/11/13): need these for MEDUSA to input/output benthic reservoirs 32 USE par_medusa 32 33 USE sms_medusa 33 34 USE trcsms_medusa … … 43 44 USE sbc_oce, ONLY: lk_oasis 44 45 USE oce, ONLY: CO2Flux_out_cpl, DMS_out_cpl, chloro_out_cpl !! Coupling variable 46 USE trcstat 47 USE obs_const, ONLY: obfillflt ! Observation operator fill value 45 48 46 49 IMPLICIT NONE … … 52 55 PUBLIC trc_rst_cal 53 56 PUBLIC trc_rst_stat 54 PUBLIC trc_rst_dia_stat 55 PUBLIC trc_rst_tra_stat 57 #if defined key_medusa && defined key_roam 58 PUBLIC trc_rst_conserve 59 #endif 56 60 57 61 !! * Substitutions … … 277 281 !! as proxy of org matter from the ocean 278 282 !! -- needed for the coupling with atm 283 !! 07-12-2017 -- To make things cleaner, we want to store an 284 !! unscaled Chl field in the restart and only 285 !! scale it when reading it in. 286 279 287 IF( iom_varid( numrtr, 'N_CHL_srf', ldstop = .FALSE. ) > 0 ) THEN 280 IF(lwp) WRITE(numout,*) 'Chl surf concentration - reading in ...'288 IF(lwp) WRITE(numout,*) 'Chl cpl concentration - reading in ... - scale by ', scl_chl 281 289 CALL iom_get( numrtr, jpdom_autoglo, 'N_CHL_srf', zn_chl_srf(:,:) ) 282 290 ELSE 283 IF(lwp) WRITE(numout,*) ' Chl surf concentration - setting to zero ...'284 zn_chl_srf(:,:) = (trn(:,:,1,jpchn) + trn(:,:,1,jpchd)) * 1.E-6291 IF(lwp) WRITE(numout,*) 'set Chl coupled concentration - scaled by ', scl_chl 292 zn_chl_srf(:,:) = MAX( 0.0, (trn(:,:,1,jpchn) + trn(:,:,1,jpchd)) * 1.E-6 ) 285 293 ENDIF 286 294 IF (lk_oasis) THEN 287 chloro_out_cpl(:,:) = zn_chl_srf(:,:) !! Coupling variable295 chloro_out_cpl(:,:) = zn_chl_srf(:,:) * scl_chl !! Coupling variable 288 296 END IF 289 297 !! … … 297 305 call trc_rst_dia_stat(zn_dms_srf(:,:), 'DMS surf') 298 306 call trc_rst_dia_stat(zn_co2_flx(:,:), 'CO2 flux') 299 call trc_rst_dia_stat(zn_chl_srf(:,:), 'CHL surf') 307 IF (lk_oasis) THEN 308 call trc_rst_dia_stat(chloro_out_cpl(:,:), 'CHL cpl') 309 END IF 300 310 !! 301 311 !! JPALM 14-06-2016 -- add Carbonate chenistry variables through the restart … … 329 339 IF(lwp) WRITE(numout,*) 'Or don t start from uncomplete restart...' 330 340 ENDIF 341 ! 342 IF ( ln_foam_medusa ) THEN 343 !! 2D fields of pCO2 and fCO2 for observation operator on first timestep 344 IF( iom_varid( numrtr, 'PCO2W', ldstop = .FALSE. ) > 0 ) THEN 345 IF(lwp) WRITE(numout,*) ' MEDUSA pCO2 present - reading in ...' 346 CALL iom_get( numrtr, jpdom_autoglo, 'PCO2W', f2_pco2w(:,:) ) 347 CALL iom_get( numrtr, jpdom_autoglo, 'FCO2W', f2_fco2w(:,:) ) 348 ELSE 349 IF(lwp) WRITE(numout,*) ' MEDUSA pCO2 absent - setting to fill ...' 350 f2_pco2w(:,:) = obfillflt * tmask(:,:,1) 351 f2_fco2w(:,:) = obfillflt * tmask(:,:,1) 352 ENDIF 353 ENDIF 331 354 # endif 332 355 IF ( ln_foam_medusa ) THEN 356 !! Fields for ocean colour assimilation on first timestep 357 IF( iom_varid( numrtr, 'pgrow_avg', ldstop = .FALSE. ) > 0 ) THEN 358 IF(lwp) WRITE(numout,*) ' MEDUSA pgrow_avg present - reading in ...' 359 CALL iom_get( numrtr, jpdom_autoglo, 'pgrow_avg', pgrow_avg(:,:) ) 360 CALL iom_get( numrtr, jpdom_autoglo, 'ploss_avg', ploss_avg(:,:) ) 361 CALL iom_get( numrtr, jpdom_autoglo, 'phyt_avg', phyt_avg(:,:) ) 362 CALL iom_get( numrtr, jpdom_autoglo, 'mld_max', mld_max(:,:) ) 363 ELSE 364 IF(lwp) WRITE(numout,*) ' MEDUSA pgrow_avg absent - setting to zero ...' 365 pgrow_avg(:,:) = 0.0 366 ploss_avg(:,:) = 0.0 367 phyt_avg(:,:) = 0.0 368 mld_max(:,:) = 0.0 369 ENDIF 370 ENDIF 333 371 334 372 #endif … … 369 407 !! 370 408 IF(lwp) WRITE(numout,*) ' CFC averaged properties absent - setting to zero ...' 371 qint_cfc(:,:,j n) = 0.0 !! CHN409 qint_cfc(:,:,jl) = 0.0 !! CHN 372 410 ENDIF 373 411 !! … … 457 495 CALL iom_rstput( kt, nitrst, numrtw, 'B_CO2_flx', zb_co2_flx(:,:) ) 458 496 CALL iom_rstput( kt, nitrst, numrtw, 'N_CO2_flx', zn_co2_flx(:,:) ) 497 !! JPALM 07-12-2017 -- To make things cleaner, we want to store an 498 !! unscaled Chl field in the restart and only 499 !! scale it when reading it in. 459 500 CALL iom_rstput( kt, nitrst, numrtw, 'N_CHL_srf', zn_chl_srf(:,:) ) 460 501 !! … … 468 509 call trc_rst_dia_stat(zn_dms_srf(:,:), 'DMS surf') 469 510 call trc_rst_dia_stat(zn_co2_flx(:,:), 'CO2 flux') 470 call trc_rst_dia_stat(zn_chl_srf(:,:), ' CHL surf')511 call trc_rst_dia_stat(zn_chl_srf(:,:), 'unscaled CHL cpl') 471 512 !! 472 513 IF(lwp) WRITE(numout,*) ' MEDUSA averaged prop. for dust and iron dep.' … … 498 539 call trc_rst_dia_stat( f2_ccd_arg(:,:),'CCD_ARG') 499 540 !! 541 IF ( ln_foam_medusa ) THEN 542 !! Fields for observation operator on first timestep 543 IF(lwp) WRITE(numout,*) ' MEDUSA OBS fields - writing out ...' 544 CALL iom_rstput( kt, nitrst, numrtw, 'PCO2W', f2_pco2w(:,:) ) 545 CALL iom_rstput( kt, nitrst, numrtw, 'FCO2W', f2_fco2w(:,:) ) 546 ENDIF 500 547 # endif 548 IF ( ln_foam_medusa ) THEN 549 !! Fields for assimilation on first timestep 550 IF(lwp) WRITE(numout,*) ' MEDUSA ASM fields - writing out ...' 551 CALL iom_rstput( kt, nitrst, numrtw, 'pgrow_avg', pgrow_avg(:,:) ) 552 CALL iom_rstput( kt, nitrst, numrtw, 'ploss_avg', ploss_avg(:,:) ) 553 CALL iom_rstput( kt, nitrst, numrtw, 'phyt_avg', phyt_avg(:,:) ) 554 CALL iom_rstput( kt, nitrst, numrtw, 'mld_max', mld_max(:,:) ) 555 ENDIF 501 556 !! 502 557 #endif … … 531 586 IF( kt == nitrst ) THEN 532 587 CALL trc_rst_stat ! statistics 588 #if defined key_medusa && defined key_roam 589 CALL trc_rst_conserve ! conservation check 590 #endif 533 591 CALL iom_close( numrtw ) ! close the restart file (only at last time step) 534 592 #if ! defined key_trdmxl_trc … … 697 755 698 756 699 SUBROUTINE trc_rst_tra_stat 700 !!---------------------------------------------------------------------- 701 !! *** trc_rst_tra_stat *** 702 !! 703 !! ** purpose : Compute tracers statistics - check where crazy values appears 704 !!---------------------------------------------------------------------- 705 INTEGER :: jk, jn 706 REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift, areasf 707 REAL(wp), DIMENSION(jpi,jpj) :: zvol 708 !!---------------------------------------------------------------------- 709 757 # if defined key_medusa && defined key_roam 758 SUBROUTINE trc_rst_conserve 759 !!---------------------------------------------------------------------- 760 !! *** trc_rst_conserve *** 761 !! 762 !! ** purpose : Compute tracers conservation statistics 763 !! 764 !! AXY (17/11/2017) 765 !! This routine calculates the "now" inventories of the elemental 766 !! cycles of MEDUSA and compares them to those calculate when the 767 !! model was initialised / restarted; the cycles calculated are: 768 !! nitrogen, silicon, iron, carbon, alkalinity and oxygen 769 !!---------------------------------------------------------------------- 770 INTEGER :: ji, jj, jk, jn 771 REAL(wp) :: zsum3d, zsum2d, zinvt, zdelta, zratio 772 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d, zvol 773 REAL(wp), DIMENSION(jpi,jpj) :: z2d, zarea 774 REAL(wp), DIMENSION(6) :: loc_cycletot3, loc_cycletot2 775 !!---------------------------------------------------------------------- 776 ! 710 777 IF( lwp ) THEN 778 WRITE(numout,*) 779 WRITE(numout,*) ' ----TRACER CONSERVATION---- ' 780 WRITE(numout,*) 781 ENDIF 782 ! 783 ! ocean volume 784 DO jk = 1, jpk 785 zvol(:,:,jk) = e1e2t(:,:) * fse3t_a(:,:,jk) * tmask(:,:,jk) 786 END DO 787 ! 788 ! ocean area (for sediments) 789 zarea(:,:) = e1e2t(:,:) * tmask(:,:,1) 790 ! 791 !---------------------------------------------------------------------- 792 ! nitrogen 793 z3d(:,:,:) = trn(:,:,:,jpphn) + trn(:,:,:,jpphd) + trn(:,:,:,jpzmi) + & 794 trn(:,:,:,jpzme) + trn(:,:,:,jpdet) + trn(:,:,:,jpdin) 795 z2d(:,:) = zn_sed_n(:,:) 796 zsum3d = glob_sum( z3d(:,:,:) * zvol(:,:,:) ) 797 zsum2d = glob_sum( z2d(:,:) * zarea(:,:) ) 798 ! total tracer, and delta 799 zinvt = zsum3d + zsum2d 800 zdelta = zinvt - cycletot(1) 801 zratio = 1.0e2 * zdelta / cycletot(1) 802 ! 803 IF ( lwp ) WRITE(numout,9010) 'nitrogen', zsum3d, zsum2d, zinvt, & 804 cycletot(1), zdelta, zratio 805 IF ( lwp ) WRITE(numout,*) 806 ! 807 !---------------------------------------------------------------------- 808 ! silicon 809 z3d(:,:,:) = trn(:,:,:,jppds) + trn(:,:,:,jpsil) 810 z2d(:,:) = zn_sed_si(:,:) 811 zsum3d = glob_sum( z3d(:,:,:) * zvol(:,:,:) ) 812 zsum2d = glob_sum( z2d(:,:) * zarea(:,:) ) 813 ! total tracer, and delta 814 zinvt = zsum3d + zsum2d 815 zdelta = zinvt - cycletot(2) 816 zratio = 1.0e2 * zdelta / cycletot(2) 817 ! 818 IF ( lwp ) WRITE(numout,9010) 'silicon', zsum3d, zsum2d, zinvt, & 819 cycletot(2), zdelta, zratio 820 IF ( lwp ) WRITE(numout,*) 821 ! 822 !---------------------------------------------------------------------- 823 ! iron 824 z3d(:,:,:) = ((trn(:,:,:,jpphn) + trn(:,:,:,jpphd) + trn(:,:,:,jpzmi) + & 825 trn(:,:,:,jpzme) + trn(:,:,:,jpdet)) * xrfn) + trn(:,:,:,jpfer) 826 z2d(:,:) = zn_sed_fe(:,:) 827 zsum3d = glob_sum( z3d(:,:,:) * zvol(:,:,:) ) 828 zsum2d = glob_sum( z2d(:,:) * zarea(:,:) ) 829 ! total tracer, and delta 830 zinvt = zsum3d + zsum2d 831 zdelta = zinvt - cycletot(3) 832 zratio = 1.0e2 * zdelta / cycletot(3) 833 ! 834 IF ( lwp ) WRITE(numout,9010) 'iron', zsum3d, zsum2d, zinvt, & 835 cycletot(3), zdelta, zratio 836 IF ( lwp ) WRITE(numout,*) 837 ! 838 !---------------------------------------------------------------------- 839 ! carbon 840 z3d(:,:,:) = (trn(:,:,:,jpphn) * xthetapn) + (trn(:,:,:,jpphd) * xthetapd) + & 841 (trn(:,:,:,jpzmi) * xthetazmi) + (trn(:,:,:,jpzme) * xthetazme) + & 842 trn(:,:,:,jpdtc) + trn(:,:,:,jpdic) 843 z2d(:,:) = zn_sed_c(:,:) + zn_sed_ca(:,:) 844 zsum3d = glob_sum( z3d(:,:,:) * zvol(:,:,:) ) 845 zsum2d = glob_sum( z2d(:,:) * zarea(:,:) ) 846 ! total tracer, and delta 847 zinvt = zsum3d + zsum2d 848 zdelta = zinvt - cycletot(4) 849 zratio = 1.0e2 * zdelta / cycletot(4) 850 ! 851 IF ( lwp ) WRITE(numout,9010) 'carbon', zsum3d, zsum2d, zinvt, & 852 cycletot(4), zdelta, zratio 853 IF ( lwp ) WRITE(numout,*) 854 ! 855 !---------------------------------------------------------------------- 856 ! alkalinity 857 z3d(:,:,:) = trn(:,:,:,jpalk) 858 z2d(:,:) = zn_sed_ca(:,:) * 2.0 859 zsum3d = glob_sum( z3d(:,:,:) * zvol(:,:,:) ) 860 zsum2d = glob_sum( z2d(:,:) * zarea(:,:) ) 861 ! total tracer, and delta 862 zinvt = zsum3d + zsum2d 863 zdelta = zinvt - cycletot(5) 864 zratio = 1.0e2 * zdelta / cycletot(5) 865 ! 866 IF ( lwp ) WRITE(numout,9010) 'alkalinity', zsum3d, zsum2d, zinvt, & 867 cycletot(5), zdelta, zratio 868 IF ( lwp ) WRITE(numout,*) 869 ! 870 !---------------------------------------------------------------------- 871 ! oxygen 872 z3d(:,:,:) = trn(:,:,:,jpoxy) 873 z2d(:,:) = 0.0 874 zsum3d = glob_sum( z3d(:,:,:) * zvol(:,:,:) ) 875 zsum2d = glob_sum( z2d(:,:) * zarea(:,:) ) 876 ! total tracer, and delta 877 zinvt = zsum3d + zsum2d 878 zdelta = zinvt - cycletot(6) 879 zratio = 1.0e2 * zdelta / cycletot(6) 880 ! 881 IF ( lwp ) WRITE(numout,9010) 'oxygen', zsum3d, zsum2d, zinvt, & 882 cycletot(6), zdelta, zratio 883 ! 884 !---------------------------------------------------------------------- 885 ! Check 886 zsum3d = glob_sum( zvol(:,:,:) ) 887 zsum2d = glob_sum( zarea(:,:) ) 888 IF ( lwp ) THEN 711 889 WRITE(numout,*) 712 WRITE(numout,*) ' ----SURFACE TRA STAT---- ' 890 WRITE(numout,*) ' check : cvol : ', zsum3d 891 WRITE(numout,*) ' check : carea : ', zsum2d 713 892 WRITE(numout,*) 714 893 ENDIF 715 894 ! 716 zvol(:,:) = e1e2t(:,:) * fse3t_a(:,:,1) * tmask(:,:,1) 717 areasf = glob_sum(zvol(:,:)) 718 DO jn = 1, jptra 719 ztraf = glob_sum( tra(:,:,1,jn) * zvol(:,:) ) 720 zmin = MINVAL( tra(:,:,1,jn), mask= ((tmask(:,:,1).NE.0.)) ) 721 zmax = MAXVAL( tra(:,:,1,jn), mask= ((tmask(:,:,1).NE.0.)) ) 722 IF( lk_mpp ) THEN 723 CALL mpp_min( zmin ) ! min over the global domain 724 CALL mpp_max( zmax ) ! max over the global domain 725 END IF 726 zmean = ztraf / areasf 727 IF(lwp) WRITE(numout,9001) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax 728 END DO 729 IF(lwp) WRITE(numout,*) 730 9001 FORMAT(' tracer nb :',i2,' name :',a10,' mean :',e18.10,' min :',e18.10, & 731 & ' max :',e18.10) 732 ! 733 END SUBROUTINE trc_rst_tra_stat 734 735 736 737 SUBROUTINE trc_rst_dia_stat( dgtr, names) 738 !!---------------------------------------------------------------------- 739 !! *** trc_rst_dia_stat *** 740 !! 741 !! ** purpose : Compute tracers statistics 742 !!---------------------------------------------------------------------- 743 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: dgtr ! 2D diag var 744 CHARACTER(len=*) , INTENT(in) :: names ! 2D diag name 745 !!--------------------------------------------------------------------- 746 INTEGER :: jk, jn 747 CHARACTER (LEN=18) :: text_zmean 748 REAL(wp) :: ztraf, zmin, zmax, zmean, areasf 749 REAL(wp), DIMENSION(jpi,jpj) :: zvol 750 !!---------------------------------------------------------------------- 751 752 IF( lwp ) WRITE(numout,*) 'STAT- ', names 753 754 ! fse3t_a will be undefined at the start of a run, but this routine 755 ! may be called at any stage! Hence we MUST make sure it is 756 ! initialised to zero when allocated to enable us to test for 757 ! zero content here and avoid potentially dangerous and non-portable 758 ! operations (e.g. divide by zero, global sums of junk values etc.) 759 zvol(:,:) = e1e2t(:,:) * fse3t_a(:,:,1) * tmask(:,:,1) 760 ztraf = glob_sum( dgtr(:,:) * zvol(:,:) ) 761 !! areasf = glob_sum(e1e2t(:,:) * tmask(:,:,1) ) 762 areasf = glob_sum(zvol(:,:)) 763 zmin = MINVAL( dgtr(:,:), mask= ((tmask(:,:,1).NE.0.)) ) 764 zmax = MAXVAL( dgtr(:,:), mask= ((tmask(:,:,1).NE.0.)) ) 765 IF( lk_mpp ) THEN 766 CALL mpp_min( zmin ) ! min over the global domain 767 CALL mpp_max( zmax ) ! max over the global domain 768 END IF 769 770 text_zmean = "N/A" 771 ! Avoid divide by zero. areasf must be positive. 772 IF (areasf > 0.0) THEN 773 zmean = ztraf / areasf 774 WRITE(text_zmean,'(e18.10)') zmean 775 ENDIF 776 777 IF(lwp) WRITE(numout,9002) TRIM( names ), text_zmean, zmin, zmax 778 779 9002 FORMAT(' tracer name :',A,' mean :',A,' min :',e18.10, & 780 & ' max :',e18.10 ) 781 ! 782 END SUBROUTINE trc_rst_dia_stat 895 9010 FORMAT(' element:',a10, & 896 ' 3d sum:',e18.10,' 2d sum:',e18.10, & 897 ' total:',e18.10,' initial:',e18.10, & 898 ' delta:',e18.10,' %:',e18.10) 899 ! 900 END SUBROUTINE trc_rst_conserve 901 # endif 783 902 784 903 -
branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
r8442 r10302 19 19 USE trcwri 20 20 USE trcrst 21 USE trcstat 21 22 USE trdtrc_oce 22 23 USE trdmxl_trc … … 177 178 ! 178 179 ! !* Restart: read in restart file 179 IF( ln_rsttr .AND. iom_varid( numrtr, 'qsr_mean' , ldstop = .FALSE. ) > 0 .AND.&180 iom_varid( numrtr, 'qsr_arr_1', ldstop = .FALSE. ) > 0 .AND.&181 iom_varid( numrtr, 'zsecfst' , ldstop = .FALSE. ) > 0 ) THEN180 IF( ln_rsttr .AND. nn_rsttr /= 0 .AND. iom_varid( numrtr, 'qsr_mean' , ldstop = .FALSE. ) > 0 & 181 .AND. iom_varid( numrtr, 'qsr_arr_1', ldstop = .FALSE. ) > 0 & 182 .AND. iom_varid( numrtr, 'zsecfst' , ldstop = .FALSE. ) > 0 ) THEN 182 183 IF(lwp) WRITE(numout,*) 'trc_qsr_mean: qsr_mean read in the restart file' 183 184 CALL iom_get( numrtr, jpdom_autoglo, 'qsr_mean', qsr_mean ) ! A mean of qsr
Note: See TracChangeset
for help on using the changeset viewer.