Changeset 7693 for branches/UKMO
- Timestamp:
- 2017-02-17T16:38:26+01:00 (7 years ago)
- Location:
- branches/UKMO/dev_r5518_MEDUSA_optim_RH/NEMOGCM
- Files:
-
- 18 edited
- 17 copied
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_MEDUSA_optim_RH/NEMOGCM/CONFIG/SHARED/namelist_cfc_ref
r4147 r7693 7 7 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 8 8 ndate_beg = 300101 ! datedeb1 9 nyear_res = 1932 ! iannee1 9 nyear_res = 1600 ! iannee1 10 simu_type = 1 ! kind of Simulation: 1 = SPIN-UP (90y-cycle) 11 !! !! 2 = Hindcast/proj (100y cycle) 10 12 / 11 13 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' -
branches/UKMO/dev_r5518_MEDUSA_optim_RH/NEMOGCM/CONFIG/cfg.txt
r7692 r7693 11 11 ORCA2_LIM OPA_SRC LIM_SRC_2 NST_SRC 12 12 ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC 13 ORCA2_OFF_MEDUSA OPA_SRC OFF_SRC TOP_SRC -
branches/UKMO/dev_r5518_MEDUSA_optim_RH/NEMOGCM/NEMO/OPA_SRC/TRD/trdtrc.F90
r7692 r7693 1 #if ! defined key_top 1 2 MODULE trdtrc 2 3 !!====================================================================== … … 22 23 !!====================================================================== 23 24 END MODULE trdtrc 25 #endif -
branches/UKMO/dev_r5518_MEDUSA_optim_RH/NEMOGCM/NEMO/TOP_SRC/C14b/par_c14b.F90
r7692 r7693 11 11 USE par_pisces , ONLY : jp_pisces_trd !: number of biological diag in PISCES 12 12 13 USE par_medusa , ONLY : jp_medusa !: number of tracers in MEDUSA 14 USE par_medusa , ONLY : jp_medusa_2d !: number of 2D diag in MEDUSA 15 USE par_medusa , ONLY : jp_medusa_3d !: number of 3D diag in MEDUSA 16 USE par_medusa , ONLY : jp_medusa_trd !: number of biological diag in MEDUSA 17 18 USE par_idtra , ONLY : jp_idtra !: number of tracers in MEDUSA 19 USE par_idtra , ONLY : jp_idtra_2d !: number of tracers in MEDUSA 20 USE par_idtra , ONLY : jp_idtra_3d !: number of tracers in MEDUSA 21 USE par_idtra , ONLY : jp_idtra_trd !: number of tracers in MEDUSA 22 13 23 USE par_cfc , ONLY : jp_cfc !: number of tracers in CFC 14 24 USE par_cfc , ONLY : jp_cfc_2d !: number of 2D diag in CFC … … 19 29 IMPLICIT NONE 20 30 21 INTEGER, PARAMETER :: jp_lb = jp_pisces + jp_cfc !: cum. number of pass. tracers 22 INTEGER, PARAMETER :: jp_lb_2d = jp_pisces_2d + jp_cfc_2d !: 23 INTEGER, PARAMETER :: jp_lb_3d = jp_pisces_3d + jp_cfc_3d !: 24 INTEGER, PARAMETER :: jp_lb_trd = jp_pisces_trd + jp_cfc_trd !: 31 INTEGER, PARAMETER :: jp_lb = jp_pisces + jp_medusa + & 32 jp_idtra + jp_cfc !: cum. number of pass. tracers 33 INTEGER, PARAMETER :: jp_lb_2d = jp_pisces_2d + jp_medusa_2d + & 34 jp_idtra_2d + jp_cfc_2d !: 35 INTEGER, PARAMETER :: jp_lb_3d = jp_pisces_3d + jp_medusa_3d + & 36 jp_idtra_3d + jp_cfc_3d !: 37 INTEGER, PARAMETER :: jp_lb_trd = jp_pisces_trd + jp_medusa_trd + & 38 jp_idtra_trd + jp_cfc_trd !: 25 39 26 40 #if defined key_c14b -
branches/UKMO/dev_r5518_MEDUSA_optim_RH/NEMOGCM/NEMO/TOP_SRC/CFC/par_cfc.F90
r7692 r7693 15 15 USE par_pisces , ONLY : jp_pisces_trd !: number of biological diag in PISCES 16 16 17 USE par_medusa , ONLY : jp_medusa !: number of tracers in MEDUSA 18 USE par_medusa , ONLY : jp_medusa_2d !: number of 2D diag in MEDUSA 19 USE par_medusa , ONLY : jp_medusa_3d !: number of 3D diag in MEDUSA 20 USE par_medusa , ONLY : jp_medusa_trd !: number of biological diag in MEDUSA 21 22 USE par_idtra , ONLY : jp_idtra !: number of tracers in MEDUSA 23 USE par_idtra , ONLY : jp_idtra_2d !: number of tracers in MEDUSA 24 USE par_idtra , ONLY : jp_idtra_3d !: number of tracers in MEDUSA 25 USE par_idtra , ONLY : jp_idtra_trd !: number of tracers in MEDUSA 26 17 27 IMPLICIT NONE 18 28 19 INTEGER, PARAMETER :: jp_lc = jp_pisces !: cumulative number of passive tracers 20 INTEGER, PARAMETER :: jp_lc_2d = jp_pisces_2d !: 21 INTEGER, PARAMETER :: jp_lc_3d = jp_pisces_3d !: 22 INTEGER, PARAMETER :: jp_lc_trd = jp_pisces_trd !: 29 INTEGER, PARAMETER :: jp_lc = jp_pisces + jp_medusa + & 30 jp_idtra !: cumulative number of passive tracers 31 INTEGER, PARAMETER :: jp_lc_2d = jp_pisces_2d + jp_medusa_2d + & 32 jp_idtra_2d !: 33 INTEGER, PARAMETER :: jp_lc_3d = jp_pisces_3d + jp_medusa_3d + & 34 jp_idtra_3d !: 35 INTEGER, PARAMETER :: jp_lc_trd = jp_pisces_trd + jp_medusa_trd + & 36 jp_idtra_trd !: 23 37 24 38 #if defined key_cfc -
branches/UKMO/dev_r5518_MEDUSA_optim_RH/NEMOGCM/NEMO/TOP_SRC/CFC/trcnam_cfc.F90
r7692 r7693 49 49 TYPE(DIAG), DIMENSION(jp_cfc_2d) :: cfcdia2d 50 50 !! 51 NAMELIST/namcfcdate/ ndate_beg, nyear_res 51 NAMELIST/namcfcdate/ ndate_beg, nyear_res, simu_type 52 52 NAMELIST/namcfcdia/ cfcdia2d ! additional diagnostics 53 53 !!---------------------------------------------------------------------- … … 72 72 WRITE(numout,*) ' initial calendar date (aammjj) for CFC ndate_beg = ', ndate_beg 73 73 WRITE(numout,*) ' restoring time constant (year) nyear_res = ', nyear_res 74 IF (simu_type==1) THEN 75 WRITE(numout,*) ' CFC running on SPIN-UP mode simu_type = ', simu_type 76 ELSEIF (simu_type==2) THEN 77 WRITE(numout,*) ' CFC running on HINDCAST/PROJECTION mode simu_type = ', simu_type 78 ENDIF 74 79 ENDIF 75 80 nyear_beg = ndate_beg / 10000 -
branches/UKMO/dev_r5518_MEDUSA_optim_RH/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90
r7692 r7693 15 15 !! cfc_init : sets constants for CFC surface forcing computation 16 16 !!---------------------------------------------------------------------- 17 USE dom_oce ! ocean space and time domain 17 18 USE oce_trc ! Ocean variables 18 19 USE par_trc ! TOP parameters … … 31 32 INTEGER , PUBLIC :: jpyear ! Number of years read in CFC1112 file 32 33 INTEGER , PUBLIC :: ndate_beg ! initial calendar date (aammjj) for CFC 34 INTEGER , PUBLIC :: simu_type ! Kind of simulation: 1- Spin-up 35 ! 2- Hindcast/projection 33 36 INTEGER , PUBLIC :: nyear_res ! restoring time constant (year) 34 37 INTEGER , PUBLIC :: nyear_beg ! initial year (aa) … … 79 82 ! 80 83 INTEGER :: ji, jj, jn, jl, jm, js 81 INTEGER :: iyear_beg, iyear_end 84 INTEGER :: iyear_beg, iyear_end, iyear_tmp 82 85 INTEGER :: im1, im2, ierr 83 86 REAL(wp) :: ztap, zdtap … … 103 106 ! Temporal interpolation 104 107 ! ---------------------- 105 iyear_beg = nyear - 1900 108 !! JPALM -- 15-06-2016 -- define 2 kind of CFC run. 109 !! we want to make cycle experiments, 110 !! to periodically compare the ocean dynamic within 111 !! 1- the SPIN-UP and 2- Hincast/Projections 112 !! -- main difference is the way to define the year of 113 !! simulation, that determine the atm pCFC. 114 !! 1-- Spin-up: our atm forcing is of 30y we cycle on. 115 !! So we do 90y CFC cycles to be in good 116 !! correspondance with the atmosphere 117 !! 2-- Hindcast/proj, instead of nyear-1900 we keep 118 !! the 2 last digit, and enable 3 cycle from 1800 to 2100. 119 !!---------------------------------------------------------------------- 120 !! 1 -- SPIN-UP 121 IF (simu_type==1) THEN 122 iyear_tmp = nyear - nyear_res !! JPALM -- in our spin-up, nyear_res is 1000 123 iyear_beg = MOD( iyear_tmp , 90 ) 124 !! JPALM -- the pCFC file only got 78 years. 125 !! So if iyear_beg > 78 then we set pCFC to 0 126 !! iyear_beg = 0 as well -- must try to avoid obvious problems 127 !! as Pcfc is set to 0.00 up to year 32, let set iyear_beg to year 10 128 !! else, must add 30 to iyear_beg to match with P_cfc indices 129 !!--------------------------------------- 130 IF ((iyear_beg > 77) .OR. (iyear_beg==0)) THEN 131 iyear_beg = 10 132 ELSE 133 iyear_beg = iyear_beg + 30 134 ENDIF 135 !! 136 !! 2 -- Hindcast/proj 137 ELSEIF (simu_type==2) THEN 138 iyear_beg = MOD(nyear, 100) 139 IF (iyear_beg < 9) iyear_beg = iyear_beg + 100 140 !! JPALM -- Same than previously, if iyear_beg is out of P_cfc range, 141 !! we want to set p_CFC to 0.00 --> set iyear_beg = 10 142 IF ((iyear_beg < 30) .OR. (iyear_beg > 107)) iyear_beg = 10 143 ENDIF 144 !! 106 145 IF ( nmonth <= 6 ) THEN 107 146 iyear_beg = iyear_beg - 1 … … 176 215 ! !----------------! 177 216 END DO ! end CFC loop ! 178 ! 179 IF( lrst_trc ) THEN 180 IF(lwp) WRITE(numout,*) 181 IF(lwp) WRITE(numout,*) 'trc_sms_cfc : cumulated input function fields written in ocean restart file ', & 182 & 'at it= ', kt,' date= ', ndastp 183 IF(lwp) WRITE(numout,*) '~~~~' 184 DO jn = jp_cfc0, jp_cfc1 185 CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) ) 186 END DO 187 ENDIF 217 ! 218 IF( kt == nittrc000 ) THEN 219 DO jl = 1, jp_cfc 220 WRITE(NUMOUT,*) ' ' 221 WRITE(NUMOUT,*) 'CFC interpolation verification ' !! Jpalm 222 WRITE(NUMOUT,*) '################################## ' 223 WRITE(NUMOUT,*) ' ' 224 if (jl.EQ.1) then 225 WRITE(NUMOUT,*) 'Traceur = CFC11: ' 226 elseif (jl.EQ.2) then 227 WRITE(NUMOUT,*) 'Traceur = CFC12: ' 228 endif 229 WRITE(NUMOUT,*) 'nyear = ', nyear 230 WRITE(NUMOUT,*) 'nmonth = ', nmonth 231 WRITE(NUMOUT,*) 'iyear_beg= ', iyear_beg 232 WRITE(NUMOUT,*) 'iyear_end= ', iyear_end 233 WRITE(NUMOUT,*) 'p_cfc(iyear_beg)= ',p_cfc(iyear_beg, 1, jl) 234 WRITE(NUMOUT,*) 'p_cfc(iyear_end)= ',p_cfc(iyear_end, 1, jl) 235 WRITE(NUMOUT,*) 'Im1= ',im1 236 WRITE(NUMOUT,*) 'Im2= ',im2 237 WRITE(NUMOUT,*) 'zpp_cfc = ',zpp_cfc 238 WRITE(NUMOUT,*) ' ' 239 END DO 240 # if defined key_debug_medusa 241 CALL flush(numout) 242 # endif 243 ENDIF 244 ! 245 !IF( lrst_trc ) THEN 246 ! IF(lwp) WRITE(numout,*) 247 ! IF(lwp) WRITE(numout,*) 'trc_sms_cfc : cumulated input function fields written in ocean restart file ', & 248 ! & 'at it= ', kt,' date= ', ndastp 249 ! IF(lwp) WRITE(numout,*) '~~~~' 250 ! DO jn = jp_cfc0, jp_cfc1 251 ! CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) ) 252 ! END DO 253 !ENDIF 188 254 ! 189 255 IF( lk_iomput ) THEN … … 203 269 END IF 204 270 ! 271 # if defined key_debug_medusa 272 IF(lwp) WRITE(numout,*) ' CFC - Check: nn_timing = ', nn_timing 273 CALL flush(numout) 274 # endif 205 275 IF( nn_timing == 1 ) CALL timing_stop('trc_sms_cfc') 206 276 ! … … 214 284 !! ** Purpose : sets constants for CFC model 215 285 !!--------------------------------------------------------------------- 216 INTEGER :: j n286 INTEGER :: jl, jn, iyear_beg, iyear_tmp 217 287 218 288 ! coefficient for CFC11 … … 254 324 sca(4,2) = -0.067430 255 325 256 IF( ln_rsttr ) THEN 257 IF(lwp) WRITE(numout,*) 258 IF(lwp) WRITE(numout,*) ' Read specific variables from CFC model ' 259 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 260 ! 261 DO jn = jp_cfc0, jp_cfc1 262 CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) ) 263 END DO 326 !!--------------------------------------------- 327 !! JPALM -- re-initialize CFC fields and diags if restart a CFC cycle, 328 !! Or if out of P_cfc range 329 IF (simu_type==1) THEN 330 iyear_tmp = nyear - nyear_res !! JPALM -- in our spin-up, nyear_res is 1000 331 iyear_beg = MOD( iyear_tmp , 90 ) 332 !!--------------------------------------- 333 IF ((iyear_beg > 77) .OR. (iyear_beg==0)) THEN 334 qtr_cfc(:,:,:) = 0._wp 335 IF(lwp) THEN 336 WRITE(numout,*) 337 WRITE(numout,*) 'restart a CFC cycle or out of P_cfc year bounds zero --' 338 WRITE(numout,*) ' -- set qtr_CFC = 0.00 --' 339 WRITE(numout,*) ' -- set qint_CFC = 0.00 --' 340 WRITE(numout,*) ' -- set trn(CFC) = 0.00 --' 341 ENDIF 342 qtr_cfc(:,:,:) = 0._wp 343 qint_cfc(:,:,:) = 0._wp 344 DO jl = 1, jp_cfc 345 jn = jp_cfc0 + jl - 1 346 trn(:,:,:,jn) = 0._wp 347 trb(:,:,:,jn) = 0._wp 348 END DO 349 ENDIF 350 !! 351 !! 2 -- Hindcast/proj 352 ELSEIF (simu_type==2) THEN 353 iyear_beg = MOD(nyear, 100) 354 IF (iyear_beg < 9) iyear_beg = iyear_beg + 100 355 IF ((iyear_beg < 30) .OR. (iyear_beg > 107)) THEN 356 qtr_cfc(:,:,:) = 0._wp 357 IF(lwp) THEN 358 WRITE(numout,*) 359 WRITE(numout,*) 'restart a CFC cycle or out of P_cfc year bounds zero --' 360 WRITE(numout,*) ' -- set qtr_CFC = 0.00 --' 361 WRITE(numout,*) ' -- set qint_CFC = 0.00 --' 362 WRITE(numout,*) ' -- set trn(CFC) = 0.00 --' 363 ENDIF 364 qtr_cfc(:,:,:) = 0._wp 365 qint_cfc(:,:,:) = 0._wp 366 DO jl = 1, jp_cfc 367 jn = jp_cfc0 + jl - 1 368 trn(:,:,:,jn) = 0._wp 369 trb(:,:,:,jn) = 0._wp 370 END DO 371 ENDIF 264 372 ENDIF 373 265 374 IF(lwp) WRITE(numout,*) 266 375 ! -
branches/UKMO/dev_r5518_MEDUSA_optim_RH/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90
r7692 r7693 27 27 USE ldftra_oce ! lateral diffusion coefficient on tracers 28 28 USE prtctl_trc ! Print control 29 !! USE lbclnk ! ocean lateral boundary conditions (or mpp link) 29 30 30 31 IMPLICIT NONE … … 71 72 INTEGER, INTENT(in) :: kt ! ocean time-step index 72 73 ! 73 INTEGER :: jk 74 INTEGER :: jk, jn 74 75 CHARACTER (len=22) :: charout 75 76 REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn ! effective velocity … … 105 106 zvn(:,:,jpk) = 0._wp ! no transport trough the bottom 106 107 zwn(:,:,jpk) = 0._wp ! no transport trough the bottom 108 ! 109 !! Jpalm -- 14-01-2016 -- restart and proc pb - try this... 110 !! DO jn = 1, jptra 111 !! CALL lbc_lnk( trn(:,:,:,jn), 'T', 1. ) 112 !! CALL lbc_lnk( trb(:,:,:,jn), 'T', 1. ) 113 !! END DO 114 ! 107 115 108 116 IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif ) & ! add the eiv transport (if necessary) -
branches/UKMO/dev_r5518_MEDUSA_optim_RH/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
r7692 r7693 102 102 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 103 103 104 IF( ln_rsttr .AND. & ! Restart: read in restart file 105 iom_varid( numrtr, 'sbc_'//TRIM(ctrcnm(1))//'_b', ldstop = .FALSE. ) > 0 ) THEN 106 IF(lwp) WRITE(numout,*) ' nittrc000-nn_dttrc surface tracer content forcing fields red in the restart file' 107 zfact = 0.5_wp 108 DO jn = 1, jptra 109 CALL iom_get( numrtr, jpdom_autoglo, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc_b(:,:,jn) ) ! before tracer content sbc 110 END DO 111 ELSE ! No restart or restart not found: Euler forward time stepping 104 !! JPALM -- 12-01-2016 -- problem after restart, maybe because of this... 105 !! -- set sbc_trc_b to 0 after restart, first, to check. 106 !!------------------------------------------------------------------------------ 107 ! IF( ln_rsttr .AND. & ! Restart: read in restart file 108 ! iom_varid( numrtr, 'sbc_'//TRIM(ctrcnm(1))//'_b', ldstop = .FALSE. ) > 0 ) THEN 109 ! IF(lwp) WRITE(numout,*) ' nittrc000-nn_dttrc surface tracer content forcing fields red in the restart file' 110 ! zfact = 0.5_wp 111 ! DO jn = 1, jptra 112 ! CALL iom_get( numrtr, jpdom_autoglo, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc_b(:,:,jn) ) ! before tracer content sbc 113 ! END DO 114 ! ELSE ! No restart or restart not found: Euler forward time stepping 112 115 zfact = 1._wp 113 116 sbc_trc_b(:,:,:) = 0._wp 114 ENDIF117 ! ENDIF 115 118 ELSE ! Swap of forcing fields 116 119 IF( ln_top_euler ) THEN -
branches/UKMO/dev_r5518_MEDUSA_optim_RH/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90
r7692 r7693 27 27 USE trcsbc ! surface boundary condition (trc_sbc routine) 28 28 USE zpshde ! partial step: hor. derivative (zps_hde routine) 29 # if defined key_debug_medusa 30 USE trcrst 31 # endif 32 29 33 30 34 #if defined key_agrif … … 65 69 ! 66 70 CALL trc_sbc( kstp ) ! surface boundary condition 71 # if defined key_debug_medusa 72 IF(lwp) WRITE(numout,*) ' MEDUSA trc_trp after trc_sbc at kt =', kstp 73 CALL trc_rst_tra_stat 74 CALL flush(numout) 75 # endif 67 76 IF( lk_trabbl ) CALL trc_bbl( kstp ) ! advective (and/or diffusive) bottom boundary layer scheme 68 77 IF( ln_trcdmp ) CALL trc_dmp( kstp ) ! internal damping trends 69 78 IF( ln_trcdmp_clo ) CALL trc_dmp_clo( kstp ) ! internal damping trends on closed seas only 70 79 CALL trc_adv( kstp ) ! horizontal & vertical advection 80 # if defined key_debug_medusa 81 IF(lwp) WRITE(numout,*) ' MEDUSA trc_trp after trc_adv at kt =', kstp 82 CALL trc_rst_tra_stat 83 CALL flush(numout) 84 # endif 71 85 CALL trc_ldf( kstp ) ! lateral mixing 72 86 IF( .NOT. lk_offline .AND. lk_zdfkpp ) & … … 76 90 #endif 77 91 CALL trc_zdf( kstp ) ! vertical mixing and after tracer fields 92 # if defined key_debug_medusa 93 IF(lwp) WRITE(numout,*) ' MEDUSA trc_trp after trc_zdf at kt =', kstp 94 CALL trc_rst_tra_stat 95 CALL flush(numout) 96 # endif 78 97 CALL trc_nxt( kstp ) ! tracer fields at next time step 98 # if defined key_debug_medusa 99 IF(lwp) WRITE(numout,*) ' MEDUSA trc_trp after trc_nxt at kt =', kstp 100 CALL trc_rst_tra_stat 101 CALL flush(numout) 102 # endif 79 103 IF( ln_trcrad ) CALL trc_rad( kstp ) ! Correct artificial negative concentrations 80 104 -
branches/UKMO/dev_r5518_MEDUSA_optim_RH/NEMOGCM/NEMO/TOP_SRC/par_trc.F90
r7692 r7693 8 8 !! 1.0 ! 2004-03 (C. Ethe) Free form and module 9 9 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) revised architecture 10 !! - ! 2014-06 (A. Yool, J. Palmieri) adding MEDUSA-2 10 11 !!---------------------------------------------------------------------- 11 12 USE par_kind ! kind parameters … … 15 16 USE par_cfc ! CFC 11 and 12 tracers 16 17 USE par_my_trc ! user defined passive tracers 18 USE par_medusa ! MEDUSA model 19 USE par_idtra ! Idealize tracer 20 USE par_age ! AGE tracer 17 21 18 22 IMPLICIT NONE … … 24 28 ! Passive tracers : Total size 25 29 ! --------------- ! total number of passive tracers, of 2d and 3d output and trend arrays 26 INTEGER, PUBLIC, PARAMETER :: jptra = jp_pisces + jp_cfc + jp_c14b + jp_my_trc 27 INTEGER, PUBLIC, PARAMETER :: jpdia2d = jp_pisces_2d + jp_cfc_2d + jp_c14b_2d + jp_my_trc_2d 28 INTEGER, PUBLIC, PARAMETER :: jpdia3d = jp_pisces_3d + jp_cfc_3d + jp_c14b_3d + jp_my_trc_3d 30 INTEGER, PUBLIC, PARAMETER :: jptra = jp_pisces + jp_cfc + jp_c14b + jp_my_trc + jp_medusa + jp_idtra + jp_age 31 INTEGER, PUBLIC, PARAMETER :: jpdia2d = jp_pisces_2d + jp_cfc_2d + jp_c14b_2d + jp_my_trc_2d + jp_medusa_2d + jp_idtra_2d + jp_age_2d 32 INTEGER, PUBLIC, PARAMETER :: jpdia3d = jp_pisces_3d + jp_cfc_3d + jp_c14b_3d + jp_my_trc_3d + jp_medusa_3d + jp_idtra_3d + jp_age_3d 29 33 ! ! total number of sms diagnostic arrays 30 INTEGER, PUBLIC, PARAMETER :: jpdiabio = jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_my_trc_trd 34 INTEGER, PUBLIC, PARAMETER :: jpdiabio = jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_my_trc_trd + jp_medusa_trd + jp_idtra_trd + jp_age_trd 31 35 32 36 ! 1D configuration ("key_c1d") -
branches/UKMO/dev_r5518_MEDUSA_optim_RH/NEMOGCM/NEMO/TOP_SRC/trc.F90
r7692 r7693 7 7 !! - ! 2000-04 (O. Aumont, M.A. Foujols) HAMOCC3 and P3ZD 8 8 !! NEMO 1.0 ! 2004-03 (C. Ethe) Free form and module 9 !! 3.6 ! 2016-11 (A. Yool) Updated diags for CMIP6 9 10 !!---------------------------------------------------------------------- 10 11 #if defined key_top … … 104 105 END TYPE DIAG 105 106 107 #if defined key_medusa && defined key_iomput 108 TYPE, PUBLIC :: BDIAG 109 LOGICAL :: dgsave 110 END TYPE BDIAG 111 112 TYPE, PUBLIC :: DIAG_IOM 113 TYPE(BDIAG) INVTN, INVTSI, INVTFE, PRN, MPN, PRD, MPD, DSED, OPAL, OPALDISS, GMIPn, & 114 GMID, MZMI, GMEPN, GMEPD, GMEZMI, GMED, MZME, DEXP, DETN, MDET, AEOLIAN, BENTHIC, & 115 SCAVENGE, PN_JLIM, PN_NLIM, PN_FELIM, PD_JLIM, PD_NLIM, PD_FELIM, PD_SILIM, & 116 PDSILIM2, SDT__100, SDT__200, SDT__500, SDT_1000, TOTREG_N, TOTRG_SI, REG__100, & 117 REG__200, REG__500, REG_1000, FASTN, FASTSI, FASTFE, FASTC, FASTCA, FDT__100, & 118 FDT__200, FDT__500, FDT_1000, RG__100F, RG__200F, RG__500F, RG_1000F, FDS__100, & 119 FDS__200, FDS__500, FDS_1000, RGS_100F, RGS_200F, RGS_500F, RGS1000F, REMINN, & 120 REMINSI, REMINFE, REMINC, REMINCA, SEAFLRN, SEAFLRSI, SEAFLRFE, SEAFLRC, SEAFLRCA, & 121 MED_QSR, MED_XPAR, INTFLX_N, INTFLX_SI, INTFLX_FE, INT_PN, INT_PD, ML_PRN, ML_PRD, & 122 OCAL_CCD, OCAL_LVL, FE_0000, FE_0100, FE_0200, FE_0500, FE_1000, MED_XZE, WIND, & 123 ATM_PCO2, OCN_PH, OCN_PCO2, OCNH2CO3, OCN_HCO3, OCN_CO3, CO2FLUX, OM_CAL, OM_ARG, & 124 TCO2, TALK, KW660, ATM_PP0, O2FLUX, O2SAT, CAL_CCD, ARG_CCD, SFR_OCAL, SFR_OARG, & 125 N_PROD, N_CONS, C_PROD, C_CONS, O2_PROD, O2_CONS, O2_ANOX, RR_0100, RR_0500, & 126 RR_1000, IBEN_N, IBEN_FE, IBEN_C, IBEN_SI, IBEN_CA, OBEN_N, OBEN_FE, OBEN_C, & 127 OBEN_SI, OBEN_CA, BEN_N, BEN_FE, BEN_C, BEN_SI, BEN_CA, RUNOFF, RIV_N, RIV_SI, & 128 RIV_C, RIV_ALK, DETC, SDC__100, SDC__200, SDC__500, SDC_1000, INVTC, INVTALK, & 129 INVTO2, LYSO_CA, COM_RESP, PN_LLOSS, PD_LLOSS, ZI_LLOSS, ZE_LLOSS, ZI_MES_N, & 130 ZI_MES_D, ZI_MES_C, ZI_MESDC, ZI_EXCR, ZI_RESP, ZI_GROW, ZE_MES_N, ZE_MES_D, & 131 ZE_MES_C, ZE_MESDC, ZE_EXCR, ZE_RESP, ZE_GROW, MDETC, GMIDC, GMEDC, & 132 INT_ZMI, INT_ZME, INT_DET, INT_DTC, DMS_SURF, DMS_ANDR, DMS_SIMO, DMS_ARAN, & 133 DMS_HALL, ATM_XCO2, OCN_FCO2, ATM_FCO2, OCN_RHOSW, OCN_SCHCO2, OCN_KWCO2, & 134 OCN_K0, CO2STARAIR, OCN_DPCO2, & ! end of regular 2D 135 TPP3, DETFLUX3, REMIN3N, PH3, OM_CAL3, & ! end of regular 3D 136 ! AXY (11/11/16): additional CMIP6 2D diagnostics 137 epC100, epCALC100, epN100, epSI100, & 138 FGCO2, INTDISSIC, INTDISSIN, INTDISSISI, INTTALK, O2min, ZO2min, & 139 FBDDTALK, FBDDTDIC, FBDDTDIFE, FBDDTDIN, FBDDTDISI, & 140 ! AXY (11/11/16): additional CMIP6 3D diagnostics 141 TPPD3, & 142 BDDTALK3, BDDTDIC3, BDDTDIFE3, BDDTDIN3, BDDTDISI3, & 143 FD_NIT3, FD_SIL3, FD_CAR3, FD_CAL3, & 144 CO33, CO3SATARAG3, CO3SATCALC3, DCALC3, & 145 EXPC3, EXPN3, EXPCALC3, EXPSI3, & 146 FEDISS3, FESCAV3, & 147 MIGRAZP3, MIGRAZD3, MEGRAZP3, MEGRAZD3, MEGRAZZ3, & 148 O2SAT3, PBSI3, PCAL3, REMOC3, & 149 PNLIMJ3, PNLIMN3, PNLIMFE3, PDLIMJ3, PDLIMN3, PDLIMFE3, PDLIMSI3 150 !! 151 !! list of all MEDUSA diagnostics that could be called by iom_use 152 END TYPE DIAG_IOM 153 !! 154 TYPE(DIAG_IOM), PUBLIC :: med_diag ! define which diagnostics are asked in outputs 155 # endif 156 106 157 !! information for inputs 107 158 !! -------------------------------------------------- -
branches/UKMO/dev_r5518_MEDUSA_optim_RH/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r7692 r7693 8 8 !! 2.0 ! 2005-10 (C. Ethe, G. Madec) revised architecture 9 9 !! 4.0 ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 10 !! - ! 2014-06 (A. Yool, J. Palmieri) adding MEDUSA-2 10 11 !!---------------------------------------------------------------------- 11 12 #if defined key_top … … 24 25 USE trcini_c14b ! C14 bomb initialisation 25 26 USE trcini_my_trc ! MY_TRC initialisation 27 USE trcini_medusa ! MEDUSA initialisation 28 USE trcini_idtra ! idealize tracer initialisation 29 USE trcini_age ! AGE initialisation 26 30 USE trcdta ! initialisation from files 27 31 USE daymod ! calendar manager … … 77 81 & CALL ctl_warn(' Coupling with passive tracers and used of diurnal cycle. & 78 82 & Computation of a daily mean shortwave for some biogeochemical models) ') 79 83 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 84 !!!!! CHECK For MEDUSA 85 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 80 86 IF( nn_cla == 1 ) & 81 87 & CALL ctl_stop( ' Cross Land Advection not yet implemented with passive tracer ; nn_cla must be 0' ) … … 98 104 99 105 IF( lk_pisces ) CALL trc_ini_pisces ! PISCES bio-model 106 IF( lk_medusa ) CALL trc_ini_medusa ! MEDUSA tracers 107 IF( lk_idtra ) CALL trc_ini_idtra ! Idealize tracers 100 108 IF( lk_cfc ) CALL trc_ini_cfc ! CFC tracers 101 109 IF( lk_c14b ) CALL trc_ini_c14b ! C14 bomb tracer 110 IF( lk_age ) CALL trc_ini_age ! AGE tracer 102 111 IF( lk_my_trc ) CALL trc_ini_my_trc ! MY_TRC tracers 103 112 104 113 CALL trc_ice_ini ! Tracers in sea ice 114 115 # if defined key_debug_medusa 116 IF (lwp) write (numout,*) '------------------------------' 117 IF (lwp) write (numout,*) 'Jpalm - debug' 118 IF (lwp) write (numout,*) ' in trc_init' 119 IF (lwp) write (numout,*) ' sms init OK' 120 IF (lwp) write (numout,*) ' next: open tracer.stat' 121 IF (lwp) write (numout,*) ' ' 122 CALL flush(numout) 123 # endif 105 124 106 125 IF( lwp ) THEN … … 110 129 ENDIF 111 130 112 IF( ln_trcdta ) CALL trc_dta_init(jptra) 113 131 # if defined key_debug_medusa 132 IF (lwp) write (numout,*) '------------------------------' 133 IF (lwp) write (numout,*) 'Jpalm - debug' 134 IF (lwp) write (numout,*) ' in trc_init' 135 IF (lwp) write (numout,*) 'open tracer.stat -- OK' 136 IF (lwp) write (numout,*) ' ' 137 CALL flush(numout) 138 # endif 139 140 141 IF( ln_trcdta ) THEN 142 #if defined key_medusa 143 IF(lwp) WRITE(numout,*) 'AXY: calling trc_dta_init' 144 IF(lwp) CALL flush(numout) 145 #endif 146 CALL trc_dta_init(jptra) 147 ENDIF 114 148 115 149 IF( ln_rsttr ) THEN 116 150 ! 151 #if defined key_medusa 152 IF(lwp) WRITE(numout,*) 'AXY: calling trc_rst_read' 153 IF(lwp) CALL flush(numout) 154 #endif 117 155 CALL trc_rst_read ! restart from a file 118 156 ! … … 141 179 ENDIF 142 180 ! 181 # if defined key_debug_medusa 182 IF (lwp) write (numout,*) '------------------------------' 183 IF (lwp) write (numout,*) 'Jpalm - debug' 184 IF (lwp) write (numout,*) ' in trc_init' 185 IF (lwp) write (numout,*) ' before trb = trn' 186 IF (lwp) write (numout,*) ' ' 187 CALL flush(numout) 188 # endif 189 ! 143 190 trb(:,:,:,:) = trn(:,:,:,:) 191 ! 192 # if defined key_debug_medusa 193 IF (lwp) write (numout,*) '------------------------------' 194 IF (lwp) write (numout,*) 'Jpalm - debug' 195 IF (lwp) write (numout,*) ' in trc_init' 196 IF (lwp) write (numout,*) ' trb = trn -- OK' 197 IF (lwp) write (numout,*) ' ' 198 CALL flush(numout) 199 # endif 144 200 ! 145 201 ENDIF … … 150 206 IF( ln_zps .AND. .NOT. lk_c1d .AND. ln_isfcav ) & 151 207 & CALL zps_hde_isf( nit000, jptra, trn, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi ) ! tracers at the bottom ocean level 152 153 208 ! 209 # if defined key_debug_medusa 210 IF (lwp) write (numout,*) '------------------------------' 211 IF (lwp) write (numout,*) 'Jpalm - debug' 212 IF (lwp) write (numout,*) ' in trc_init' 213 IF (lwp) write (numout,*) ' partial step -- OK' 214 IF (lwp) write (numout,*) ' ' 215 CALL flush(numout) 216 # endif 154 217 ! 155 218 IF( nn_dttrc /= 1 ) CALL trc_sub_ini ! Initialize variables for substepping passive tracers 156 219 ! 157 220 # if defined key_debug_medusa 221 IF (lwp) write (numout,*) '------------------------------' 222 IF (lwp) write (numout,*) 'Jpalm - debug' 223 IF (lwp) write (numout,*) ' in trc_init' 224 IF (lwp) write (numout,*) ' before initiate tracer contents' 225 IF (lwp) write (numout,*) ' ' 226 CALL flush(numout) 227 # endif 228 ! 158 229 trai(:) = 0._wp ! initial content of all tracers 159 230 DO jn = 1, jptra … … 168 239 WRITE(numout,*) ' *** Total inital content of all tracers ' 169 240 WRITE(numout,*) 241 # if defined key_debug_medusa 242 CALL flush(numout) 243 # endif 244 ! 245 # if defined key_debug_medusa 246 WRITE(numout,*) ' litle check : ', ctrcnm(1) 247 CALL flush(numout) 248 # endif 170 249 DO jn = 1, jptra 171 250 WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn) … … 180 259 CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 181 260 ENDIF 261 262 IF(lwp) WRITE(numout,*) 263 IF(lwp) WRITE(numout,*) 'trc_init : passive tracer set up completed' 264 IF(lwp) WRITE(numout,*) '~~~~~~~' 265 IF(lwp) CALL flush(numout) 266 # if defined key_debug_medusa 267 CALL trc_rst_stat 268 CALL flush(numout) 269 # endif 270 182 271 9000 FORMAT(' tracer nb : ',i2,' name :',a10,' initial content :',e18.10) 183 272 ! -
branches/UKMO/dev_r5518_MEDUSA_optim_RH/NEMOGCM/NEMO/TOP_SRC/trcnam.F90
r7692 r7693 11 11 !! - ! 2001-01 (E Kestenare) suppress ndttrc=1 for CEN2 and TVD schemes 12 12 !! 1.0 ! 2005-03 (O. Aumont, A. El Moussaoui) F90 13 !! - ! 2014-06 (A. Yool, J. Palmieri) adding MEDUSA-2 13 14 !!---------------------------------------------------------------------- 14 15 #if defined key_top … … 25 26 USE trcnam_c14b ! C14 SMS namelist 26 27 USE trcnam_my_trc ! MY_TRC SMS namelist 28 USE trcnam_medusa ! MEDUSA namelist 29 USE trcnam_idtra ! Idealise tracer namelist 30 USE trcnam_age ! AGE SMS namelist 27 31 USE trd_oce 28 32 USE trdtrc_oce … … 54 58 !! ** Method : - read passive tracer namelist 55 59 !! - read namelist of each defined SMS model 56 !! ( (PISCES, CFC, MY_TRC )57 !!--------------------------------------------------------------------- 58 INTEGER :: jn ! dummy loop indice60 !! ( (PISCES, CFC, MY_TRC, MEDUSA, IDTRA, Age ) 61 !!--------------------------------------------------------------------- 62 INTEGER :: jn, jk ! dummy loop indice 59 63 ! ! Parameters of the run 60 64 IF( .NOT. lk_offline ) CALL trc_nam_run 61 65 62 66 ! ! passive tracer informations 67 # if defined key_debug_medusa 68 CALL flush(numout) 69 IF (lwp) write (numout,*) '------------------------------' 70 IF (lwp) write (numout,*) 'Jpalm - debug' 71 IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_trc' 72 IF (lwp) write (numout,*) ' ' 73 # endif 74 ! 63 75 CALL trc_nam_trc 64 76 65 77 ! ! Parameters of additional diagnostics 78 # if defined key_debug_medusa 79 CALL flush(numout) 80 IF (lwp) write (numout,*) '------------------------------' 81 IF (lwp) write (numout,*) 'Jpalm - debug' 82 IF (lwp) write (numout,*) 'CALL trc_nam_trc -- OK' 83 IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_dia' 84 IF (lwp) write (numout,*) ' ' 85 # endif 86 ! 87 66 88 CALL trc_nam_dia 67 89 68 90 ! ! namelist of transport 91 # if defined key_debug_medusa 92 CALL flush(numout) 93 IF (lwp) write (numout,*) '------------------------------' 94 IF (lwp) write (numout,*) 'Jpalm - debug' 95 IF (lwp) write (numout,*) 'CALL trc_nam_dia -- OK' 96 IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_trp' 97 IF (lwp) write (numout,*) ' ' 98 # endif 99 ! 69 100 CALL trc_nam_trp 101 ! 102 # if defined key_debug_medusa 103 CALL flush(numout) 104 IF (lwp) write (numout,*) '------------------------------' 105 IF (lwp) write (numout,*) 'Jpalm - debug' 106 IF (lwp) write (numout,*) 'CALL trc_nam_trp -- OK' 107 IF (lwp) write (numout,*) 'continue trc_nam ' 108 IF (lwp) write (numout,*) ' ' 109 CALL flush(numout) 110 # endif 111 ! 70 112 71 113 … … 89 131 END DO 90 132 WRITE(numout,*) ' ' 133 # if defined key_debug_medusa 134 CALL flush(numout) 135 # endif 91 136 ENDIF 92 137 … … 107 152 WRITE(numout,*) 108 153 ENDIF 109 ENDIF 110 154 # if defined key_debug_medusa 155 CALL flush(numout) 156 # endif 157 ENDIF 158 159 # if defined key_debug_medusa 160 DO jk = 1, jpk 161 WRITE(numout,*) ' level number: ', jk, 'rdttrc: ',rdttrc(jk),'rdttra: ', rdttra(jk),'nn_dttrc: ', nn_dttrc 162 END DO 163 CALL flush(numout) 164 # endif 111 165 112 166 rdttrc(:) = rdttra(:) * FLOAT( nn_dttrc ) ! vertical profile of passive tracer time-step … … 116 170 WRITE(numout,*) ' Passive Tracer time step rdttrc = ', rdttrc(1) 117 171 WRITE(numout,*) 172 # if defined key_debug_medusa 173 CALL flush(numout) 174 # endif 118 175 ENDIF 119 176 … … 143 200 IF( ln_trdtrc(jn) ) WRITE(numout,*) ' compute ML trends for tracer number :', jn 144 201 END DO 202 WRITE(numout,*) ' ' 203 CALL flush(numout) 145 204 ENDIF 146 205 #endif 147 206 207 # if defined key_debug_medusa 208 CALL flush(numout) 209 IF (lwp) write (numout,*) '------------------------------' 210 IF (lwp) write (numout,*) 'Jpalm - debug' 211 IF (lwp) write (numout,*) 'just before ice module for tracers call : ' 212 IF (lwp) write (numout,*) ' ' 213 # endif 214 ! 148 215 149 216 ! Call the ice module for tracers 150 217 ! ------------------------------- 151 218 CALL trc_nam_ice 219 220 # if defined key_debug_medusa 221 CALL flush(numout) 222 IF (lwp) write (numout,*) '------------------------------' 223 IF (lwp) write (numout,*) 'Jpalm - debug' 224 IF (lwp) write (numout,*) 'Will now read SMS namelists : ' 225 IF (lwp) write (numout,*) ' ' 226 # endif 227 ! 152 228 153 229 ! namelist of SMS … … 156 232 ELSE ; IF(lwp) WRITE(numout,*) ' PISCES not used' 157 233 ENDIF 158 234 ! 235 # if defined key_debug_medusa 236 CALL flush(numout) 237 IF (lwp) write (numout,*) '------------------------------' 238 IF (lwp) write (numout,*) 'Jpalm - debug' 239 IF (lwp) write (numout,*) 'CALL trc_nam_pisces -- OK' 240 IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_medusa' 241 IF (lwp) write (numout,*) ' ' 242 # endif 243 ! 244 IF( lk_medusa ) THEN ; CALL trc_nam_medusa ! MEDUSA tracers 245 ELSE ; IF(lwp) WRITE(numout,*) ' MEDUSA not used' 246 ENDIF 247 ! 248 # if defined key_debug_medusa 249 CALL flush(numout) 250 IF (lwp) write (numout,*) '------------------------------' 251 IF (lwp) write (numout,*) 'Jpalm - debug' 252 IF (lwp) write (numout,*) 'CALL trc_nam_medusa -- OK' 253 IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_idtra' 254 IF (lwp) write (numout,*) ' ' 255 # endif 256 ! 257 IF( lk_idtra ) THEN ; CALL trc_nam_idtra ! Idealize tracers 258 ELSE ; IF(lwp) WRITE(numout,*) ' Idealize tracers not used' 259 ENDIF 260 ! 261 # if defined key_debug_medusa 262 CALL flush(numout) 263 IF (lwp) write (numout,*) '------------------------------' 264 IF (lwp) write (numout,*) 'Jpalm - debug' 265 IF (lwp) write (numout,*) 'CALL trc_nam_idtra -- OK' 266 IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_cfc' 267 IF (lwp) write (numout,*) ' ' 268 # endif 269 ! 159 270 IF( lk_cfc ) THEN ; CALL trc_nam_cfc ! CFC tracers 160 271 ELSE ; IF(lwp) WRITE(numout,*) ' CFC not used' 161 272 ENDIF 162 273 ! 274 # if defined key_debug_medusa 275 CALL flush(numout) 276 IF (lwp) write (numout,*) '------------------------------' 277 IF (lwp) write (numout,*) 'Jpalm - debug' 278 IF (lwp) write (numout,*) 'CALL trc_nam_cfc -- OK' 279 IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_c14' 280 IF (lwp) write (numout,*) ' ' 281 # endif 282 ! 163 283 IF( lk_c14b ) THEN ; CALL trc_nam_c14b ! C14 bomb tracers 164 284 ELSE ; IF(lwp) WRITE(numout,*) ' C14 not used' 165 285 ENDIF 166 286 ! 287 # if defined key_debug_medusa 288 CALL flush(numout) 289 IF (lwp) write (numout,*) '------------------------------' 290 IF (lwp) write (numout,*) 'Jpalm - debug' 291 IF (lwp) write (numout,*) 'CALL trc_nam_c14 -- OK' 292 IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_age' 293 IF (lwp) write (numout,*) ' ' 294 # endif 295 ! 296 IF( lk_age ) THEN ; CALL trc_nam_age ! AGE tracer 297 ELSE ; IF(lwp) WRITE(numout,*) ' AGE not used' 298 ENDIF 299 ! 300 # if defined key_debug_medusa 301 CALL flush(numout) 302 IF (lwp) write (numout,*) '------------------------------' 303 IF (lwp) write (numout,*) 'Jpalm - debug' 304 IF (lwp) write (numout,*) 'CALL trc_nam_age -- OK' 305 IF (lwp) write (numout,*) 'in trc_nam - CALL trc_nam -- OK' 306 IF (lwp) write (numout,*) ' ' 307 # endif 308 ! 167 309 IF( lk_my_trc ) THEN ; CALL trc_nam_my_trc ! MY_TRC tracers 168 310 ELSE ; IF(lwp) WRITE(numout,*) ' MY_TRC not used' 169 311 ENDIF 170 ! 312 313 IF(lwp) CALL flush(numout) 171 314 END SUBROUTINE trc_nam 172 315 … … 216 359 WRITE(numout,*) ' Use euler integration for TRC (y/n) ln_top_euler = ', ln_top_euler 217 360 WRITE(numout,*) ' ' 361 CALL flush(numout) 218 362 ENDIF 219 363 ! … … 306 450 ln_trc_wri(jn) = sn_tracer(jn)%llsave 307 451 END DO 308 452 IF(lwp) CALL flush(numout) 453 309 454 END SUBROUTINE trc_nam_trc 310 455 … … 357 502 WRITE(numout,*) ' frequency of outputs for biological trends nn_writebio = ', nn_writebio 358 503 WRITE(numout,*) ' ' 359 ENDIF 360 361 IF( ln_diatrc .AND. .NOT. lk_iomput ) THEN 504 CALL flush(numout) 505 ENDIF 506 !! 507 !! JPALM -- 17-07-2015 -- 508 !! MEDUSA is not yet up-to-date with the iom server. 509 !! we use it for the main tracer, but not fully with diagnostics. 510 !! will have to adapt it properly when visiting Christian Ethee 511 !! for now, we change 512 !! IF( ln_diatrc .AND. .NOT. lk_iomput ) THEN 513 !! to : 514 !! 515 IF( ( ln_diatrc .AND. .NOT. lk_iomput ) .OR. ( ln_diatrc .AND. lk_medusa ) ) THEN 362 516 ALLOCATE( trc2d(jpi,jpj,jpdia2d), trc3d(jpi,jpj,jpk,jpdia3d), & 363 517 & ctrc2d(jpdia2d), ctrc2l(jpdia2d), ctrc2u(jpdia2d) , & … … 368 522 trc3d(:,:,:,:) = 0._wp ; ctrc3d(:) = ' ' ; ctrc3l(:) = ' ' ; ctrc3u(:) = ' ' 369 523 ! 524 !! ELSE IF ( lk_iomput .AND. lk_medusa .AND. .NOT. ln_diatrc) THEN 525 !! CALL trc_nam_iom_medusa 370 526 ENDIF 371 527 -
branches/UKMO/dev_r5518_MEDUSA_optim_RH/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
r7692 r7693 27 27 USE trcnam_trp 28 28 USE iom 29 USE ioipsl, ONLY : ju2ymds ! for calendar 29 30 USE daymod 31 !! AXY (05/11/13): need these for MEDUSA to input/output benthic reservoirs 32 USE sms_medusa 33 USE trcsms_medusa 34 !! 35 #if defined key_idtra 36 USE trcsms_idtra 37 #endif 38 !! 39 #if defined key_cfc 40 USE trcsms_cfc 41 #endif 42 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 43 USE sbc_oce, ONLY: lk_oasis 44 USE oce, ONLY: CO2Flux_out_cpl, DMS_out_cpl !! Coupling variable 45 30 46 IMPLICIT NONE 31 47 PRIVATE … … 35 51 PUBLIC trc_rst_wri ! called by ??? 36 52 PUBLIC trc_rst_cal 53 PUBLIC trc_rst_stat 54 PUBLIC trc_rst_dia_stat 55 PUBLIC trc_rst_tra_stat 37 56 38 57 !! * Substitutions … … 48 67 !!---------------------------------------------------------------------- 49 68 INTEGER, INTENT(in) :: kt ! number of iteration 69 INTEGER :: iyear, imonth, iday 70 REAL (wp) :: zsec 71 REAL (wp) :: zfjulday 50 72 ! 51 73 CHARACTER(LEN=20) :: clkt ! ocean time-step define as a character … … 78 100 ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 2*nn_dttrc + 1 79 101 IF( kt == nitrst - 2*nn_dttrc .OR. nstock == nn_dttrc .OR. ( kt == nitend - nn_dttrc .AND. .NOT. lrst_trc ) ) THEN 80 ! beware of the format used to write kt (default is i8.8, that should be large enough) 81 IF( nitrst > 1.0e9 ) THEN ; WRITE(clkt,* ) nitrst 82 ELSE ; WRITE(clkt,'(i8.8)') nitrst 102 IF ( ln_rstdate ) THEN 103 !! JPALM -- 22-12-2015 -- modif to get the good date on restart trc file name 104 !! -- the condition to open the rst file is not the same than for the dynamic rst. 105 !! -- here it - for an obscure reason - is open 2 time-step before the restart writing process 106 !! instead of 1. 107 !! -- i am not sure if someone forgot +1 in the if loop condition as 108 !! it is writen in all comments nitrst -2*nn_dttrc + 1 and the condition is 109 !! nitrst - 2*nn_dttrc 110 !! -- nevertheless we didn't wanted to broke something already working 111 !! and just adapted the part we added. 112 !! -- So instead of calling ju2ymds( fjulday + (rdttra(1)) 113 !! we call ju2ymds( fjulday + (2*rdttra(1)) 114 !!-------------------------------------------------------------------- 115 zfjulday = fjulday + (2*rdttra(1)) / rday 116 IF( ABS(zfjulday - REAL(NINT(zfjulday),wp)) < 0.1 / rday ) zfjulday = REAL(NINT(zfjulday),wp) ! avoid truncation error 117 CALL ju2ymds( zfjulday + (2*rdttra(1)) / rday, iyear, imonth, iday, zsec ) 118 WRITE(clkt, '(i4.4,2i2.2)') iyear, imonth, iday 119 ELSE 120 ! beware of the format used to write kt (default is i8.8, that should be large enough) 121 IF( nitrst > 1.0e9 ) THEN ; WRITE(clkt,* ) nitrst 122 ELSE ; WRITE(clkt,'(i8.8)') nitrst 123 ENDIF 83 124 ENDIF 84 125 ! create the file … … 101 142 !! ** purpose : read passive tracer fields in restart files 102 143 !!---------------------------------------------------------------------- 103 INTEGER :: jn 144 INTEGER :: jn, jl 145 !! AXY (05/11/13): temporary variables 146 REAL(wp) :: fq0,fq1,fq2 104 147 105 148 !!---------------------------------------------------------------------- … … 112 155 DO jn = 1, jptra 113 156 CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) 157 trn(:,:,:,jn) = trn(:,:,:,jn) * tmask(:,:,:) 114 158 END DO 115 159 116 160 DO jn = 1, jptra 117 161 CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 118 END DO 162 trb(:,:,:,jn) = trb(:,:,:,jn) * tmask(:,:,:) 163 END DO 164 ! 165 !! AXY (09/06/14): the ARCHER version of MEDUSA-2 does not include an equivalent 166 !! call to MEDUSA-2 at this point; this suggests that the FCM 167 !! version of NEMO date significantly earlier than the current 168 !! version 169 170 #if defined key_medusa 171 !! AXY (13/01/12): check if the restart contains sediment fields; 172 !! this is only relevant for simulations that include 173 !! biogeochemistry and are restarted from earlier runs 174 !! in which there was no sediment component 175 !! 176 IF( iom_varid( numrtr, 'B_SED_N', ldstop = .FALSE. ) > 0 ) THEN 177 !! YES; in which case read them 178 !! 179 IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields present - reading in ...' 180 CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_N', zb_sed_n(:,:) ) 181 CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_N', zn_sed_n(:,:) ) 182 CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_FE', zb_sed_fe(:,:) ) 183 CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_FE', zn_sed_fe(:,:) ) 184 CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_SI', zb_sed_si(:,:) ) 185 CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_SI', zn_sed_si(:,:) ) 186 CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_C', zb_sed_c(:,:) ) 187 CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_C', zn_sed_c(:,:) ) 188 CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_CA', zb_sed_ca(:,:) ) 189 CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_CA', zn_sed_ca(:,:) ) 190 ELSE 191 !! NO; in which case set them to zero 192 !! 193 IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields absent - setting to zero ...' 194 zb_sed_n(:,:) = 0.0 !! organic N 195 zn_sed_n(:,:) = 0.0 196 zb_sed_fe(:,:) = 0.0 !! organic Fe 197 zn_sed_fe(:,:) = 0.0 198 zb_sed_si(:,:) = 0.0 !! inorganic Si 199 zn_sed_si(:,:) = 0.0 200 zb_sed_c(:,:) = 0.0 !! organic C 201 zn_sed_c(:,:) = 0.0 202 zb_sed_ca(:,:) = 0.0 !! inorganic C 203 zn_sed_ca(:,:) = 0.0 204 ENDIF 205 !! 206 !! calculate stats on these fields 207 IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...' 208 call trc_rst_dia_stat(zn_sed_n(:,:), 'Sediment N') 209 call trc_rst_dia_stat(zn_sed_fe(:,:), 'Sediment Fe') 210 call trc_rst_dia_stat(zn_sed_si(:,:), 'Sediment Si') 211 call trc_rst_dia_stat(zn_sed_c(:,:), 'Sediment C') 212 call trc_rst_dia_stat(zn_sed_ca(:,:), 'Sediment Ca') 213 !! 214 !! AXY (07/07/15): read in temporally averaged fields for DMS 215 !! calculations 216 !! 217 IF( iom_varid( numrtr, 'B_DMS_CHN', ldstop = .FALSE. ) > 0 ) THEN 218 !! YES; in which case read them 219 !! 220 IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS present - reading in ...' 221 CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_CHN', zb_dms_chn(:,:) ) 222 CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_CHN', zn_dms_chn(:,:) ) 223 CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_CHD', zb_dms_chd(:,:) ) 224 CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_CHD', zn_dms_chd(:,:) ) 225 CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_MLD', zb_dms_mld(:,:) ) 226 CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_MLD', zn_dms_mld(:,:) ) 227 CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_QSR', zb_dms_qsr(:,:) ) 228 CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_QSR', zn_dms_qsr(:,:) ) 229 CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_DIN', zb_dms_din(:,:) ) 230 CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_DIN', zn_dms_din(:,:) ) 231 ELSE 232 !! NO; in which case set them to zero 233 !! 234 IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS absent - setting to zero ...' 235 zb_dms_chn(:,:) = 0.0 !! CHN 236 zn_dms_chn(:,:) = 0.0 237 zb_dms_chd(:,:) = 0.0 !! CHD 238 zn_dms_chd(:,:) = 0.0 239 zb_dms_mld(:,:) = 0.0 !! MLD 240 zn_dms_mld(:,:) = 0.0 241 zb_dms_qsr(:,:) = 0.0 !! QSR 242 zn_dms_qsr(:,:) = 0.0 243 zb_dms_din(:,:) = 0.0 !! DIN 244 zn_dms_din(:,:) = 0.0 245 ENDIF 246 !! 247 !! JPALM 14-06-2016 -- add CO2 flux and DMS surf through the restart 248 !! -- needed for the coupling with atm 249 IF( iom_varid( numrtr, 'B_DMS_srf', ldstop = .FALSE. ) > 0 ) THEN 250 IF(lwp) WRITE(numout,*) 'DMS surf concentration - reading in ...' 251 CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_srf', zb_dms_srf(:,:) ) 252 CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_srf', zn_dms_srf(:,:) ) 253 ELSE 254 IF(lwp) WRITE(numout,*) 'DMS surf concentration - setting to zero ...' 255 zb_dms_srf(:,:) = 0.0 !! DMS 256 zn_dms_srf(:,:) = 0.0 257 ENDIF 258 IF (lk_oasis) THEN 259 DMS_out_cpl(:,:) = zn_dms_srf(:,:) !! Coupling variable 260 END IF 261 !! 262 IF( iom_varid( numrtr, 'B_CO2_flx', ldstop = .FALSE. ) > 0 ) THEN 263 IF(lwp) WRITE(numout,*) 'CO2 air-sea flux - reading in ...' 264 CALL iom_get( numrtr, jpdom_autoglo, 'B_CO2_flx', zb_co2_flx(:,:) ) 265 CALL iom_get( numrtr, jpdom_autoglo, 'N_CO2_flx', zn_co2_flx(:,:) ) 266 ELSE 267 IF(lwp) WRITE(numout,*) 'CO2 air-sea flux - setting to zero ...' 268 zb_co2_flx(:,:) = 0.0 !! CO2 flx 269 zn_co2_flx(:,:) = 0.0 270 ENDIF 271 IF (lk_oasis) THEN 272 CO2Flux_out_cpl(:,:) = zn_co2_flx(:,:) !! Coupling variable 273 END IF 274 !! 275 !! calculate stats on these fields 276 IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS stats (min, max, sum) ...' 277 call trc_rst_dia_stat(zn_dms_chn(:,:), 'DMS, CHN') 278 call trc_rst_dia_stat(zn_dms_chd(:,:), 'DMS, CHD') 279 call trc_rst_dia_stat(zn_dms_mld(:,:), 'DMS, MLD') 280 call trc_rst_dia_stat(zn_dms_qsr(:,:), 'DMS, QSR') 281 call trc_rst_dia_stat(zn_dms_din(:,:), 'DMS, DIN') 282 call trc_rst_dia_stat(zn_dms_srf(:,:), 'DMS surf') 283 call trc_rst_dia_stat(zn_co2_flx(:,:), 'CO2 flux') 284 !! 285 !! JPALM 14-06-2016 -- add Carbonate chenistry variables through the restart 286 !! -- needed for monthly call of carb-chem routine and better reproducibility 287 # if defined key_roam 288 IF( iom_varid( numrtr, 'pH_3D', ldstop = .FALSE. ) > 0 ) THEN 289 IF(lwp) WRITE(numout,*) 'Carbonate chem variable - reading in ...' 290 CALL iom_get( numrtr, jpdom_autoglo, 'pH_3D' , f3_pH(:,:,:) ) 291 CALL iom_get( numrtr, jpdom_autoglo, 'h2CO3_3D', f3_h2co3(:,:,:) ) 292 CALL iom_get( numrtr, jpdom_autoglo, 'hCO3_3D' , f3_hco3(:,:,:) ) 293 CALL iom_get( numrtr, jpdom_autoglo, 'CO3_3D' , f3_co3(:,:,:) ) 294 CALL iom_get( numrtr, jpdom_autoglo, 'omcal_3D', f3_omcal(:,:,:) ) 295 CALL iom_get( numrtr, jpdom_autoglo, 'omarg_3D', f3_omarg(:,:,:) ) 296 CALL iom_get( numrtr, jpdom_autoglo, 'CCD_CAL' , f2_ccd_cal(:,:) ) 297 CALL iom_get( numrtr, jpdom_autoglo, 'CCD_ARG' , f2_ccd_arg(:,:) ) 298 !! 299 IF(lwp) WRITE(numout,*) ' MEDUSA averaged Carb-chem stats (min, max, sum) ...' 300 call trc_rst_dia_stat( f3_pH(:,:,1) ,'pH 3D surf') 301 call trc_rst_dia_stat( f3_h2co3(:,:,1),'h2CO3 3D surf') 302 call trc_rst_dia_stat( f3_hco3(:,:,1) ,'hCO3 3D surf' ) 303 call trc_rst_dia_stat( f3_co3(:,:,1) ,'CO3 3D surf' ) 304 call trc_rst_dia_stat( f3_omcal(:,:,1),'omcal 3D surf') 305 call trc_rst_dia_stat( f3_omarg(:,:,1),'omarg 3D surf') 306 call trc_rst_dia_stat( f2_ccd_cal(:,:),'CCD_CAL') 307 call trc_rst_dia_stat( f2_ccd_arg(:,:),'CCD_ARG') 308 309 ELSE 310 IF(lwp) WRITE(numout,*) 'WARNING : No Carbonate-chem variable in the restart.... ' 311 IF(lwp) WRITE(numout,*) 'Is not a problem if start a month, but may be very problematic if not ' 312 IF(lwp) WRITE(numout,*) 'Check if mod(kt*rdt,2592000) == rdt' 313 IF(lwp) WRITE(numout,*) 'Or don t start from uncomplete restart...' 314 ENDIF 315 # endif 316 317 318 #endif 319 ! 320 #if defined key_idtra 321 !! JPALM -- 05-01-2016 -- mv idtra and CFC restart reading and 322 !! writting here undre their key. 323 !! problems in CFC restart, maybe because of this... 324 !! and pb in idtra diag or diad-restart writing. 325 !!---------------------------------------------------------------------- 326 IF( iom_varid( numrtr, 'qint_IDTRA', ldstop = .FALSE. ) > 0 ) THEN 327 !! YES; in which case read them 328 !! 329 IF(lwp) WRITE(numout,*) ' IDTRA averaged properties present - reading in ...' 330 CALL iom_get( numrtr, jpdom_autoglo, 'qint_IDTRA', qint_idtra(:,:,1) ) 331 ELSE 332 !! NO; in which case set them to zero 333 !! 334 IF(lwp) WRITE(numout,*) ' IDTRA averaged properties absent - setting to zero ...' 335 qint_idtra(:,:,1) = 0.0 !! CHN 336 ENDIF 337 !! 338 !! calculate stats on these fields 339 IF(lwp) WRITE(numout,*) ' IDTRA averaged properties stats (min, max, sum) ...' 340 call trc_rst_dia_stat(qint_idtra(:,:,1), 'qint_IDTRA') 341 #endif 342 ! 343 #if defined key_cfc 344 DO jl = 1, jp_cfc 345 jn = jp_cfc0 + jl - 1 346 IF( iom_varid( numrtr, 'qint_'//ctrcnm(jn), ldstop = .FALSE. ) > 0 ) THEN 347 !! YES; in which case read them 348 !! 349 IF(lwp) WRITE(numout,*) ' CFC averaged properties present - reading in ...' 350 CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jl) ) 351 ELSE 352 !! NO; in which case set them to zero 353 !! 354 IF(lwp) WRITE(numout,*) ' CFC averaged properties absent - setting to zero ...' 355 qint_cfc(:,:,jn) = 0.0 !! CHN 356 ENDIF 357 !! 358 !! calculate stats on these fields 359 IF(lwp) WRITE(numout,*) ' CFC averaged properties stats (min, max, sum) ...' 360 call trc_rst_dia_stat(qint_cfc(:,:,jl), 'qint_'//ctrcnm(jn)) 361 END DO 362 #endif 119 363 ! 120 364 END SUBROUTINE trc_rst_read … … 128 372 INTEGER, INTENT( in ) :: kt ! ocean time-step index 129 373 !! 130 INTEGER :: jn 374 INTEGER :: jn, jl 131 375 REAL(wp) :: zarak0 376 !! AXY (05/11/13): temporary variables 377 REAL(wp) :: fq0,fq1,fq2 132 378 !!---------------------------------------------------------------------- 133 379 ! … … 142 388 CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 143 389 END DO 144 ! 390 391 !! AXY (09/06/14): the ARCHER version of MEDUSA-2 does not include an equivalent 392 !! call to MEDUSA-2 at this point; this suggests that the FCM 393 !! version of NEMO date significantly earlier than the current 394 !! version 395 396 #if defined key_medusa 397 !! AXY (13/01/12): write out "before" and "now" state of seafloor 398 !! sediment pools into restart; this happens 399 !! whether or not the pools are to be used by 400 !! MEDUSA (which is controlled by a switch in the 401 !! namelist_top file) 402 !! 403 IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields - writing out ...' 404 CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_N', zb_sed_n(:,:) ) 405 CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_N', zn_sed_n(:,:) ) 406 CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_FE', zb_sed_fe(:,:) ) 407 CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_FE', zn_sed_fe(:,:) ) 408 CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_SI', zb_sed_si(:,:) ) 409 CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_SI', zn_sed_si(:,:) ) 410 CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_C', zb_sed_c(:,:) ) 411 CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_C', zn_sed_c(:,:) ) 412 CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_CA', zb_sed_ca(:,:) ) 413 CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_CA', zn_sed_ca(:,:) ) 414 !! 415 !! calculate stats on these fields 416 IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...' 417 call trc_rst_dia_stat(zn_sed_n(:,:), 'Sediment N') 418 call trc_rst_dia_stat(zn_sed_fe(:,:), 'Sediment Fe') 419 call trc_rst_dia_stat(zn_sed_si(:,:), 'Sediment Si') 420 call trc_rst_dia_stat(zn_sed_c(:,:), 'Sediment C') 421 call trc_rst_dia_stat(zn_sed_ca(:,:), 'Sediment Ca') 422 !! 423 !! AXY (07/07/15): write out temporally averaged fields for DMS 424 !! calculations 425 !! 426 IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS - writing out ...' 427 CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_CHN', zb_dms_chn(:,:) ) 428 CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_CHN', zn_dms_chn(:,:) ) 429 CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_CHD', zb_dms_chd(:,:) ) 430 CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_CHD', zn_dms_chd(:,:) ) 431 CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_MLD', zb_dms_mld(:,:) ) 432 CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_MLD', zn_dms_mld(:,:) ) 433 CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_QSR', zb_dms_qsr(:,:) ) 434 CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_QSR', zn_dms_qsr(:,:) ) 435 CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_DIN', zb_dms_din(:,:) ) 436 CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_DIN', zn_dms_din(:,:) ) 437 !! JPALM 14-06-2016 -- add CO2 flux and DMS surf through the restart 438 !! -- needed for the coupling with atm 439 CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_srf', zb_dms_srf(:,:) ) 440 CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_srf', zn_dms_srf(:,:) ) 441 CALL iom_rstput( kt, nitrst, numrtw, 'B_CO2_flx', zb_co2_flx(:,:) ) 442 CALL iom_rstput( kt, nitrst, numrtw, 'N_CO2_flx', zn_co2_flx(:,:) ) 443 !! 444 !! calculate stats on these fields 445 IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS stats (min, max, sum) ...' 446 call trc_rst_dia_stat(zn_dms_chn(:,:), 'DMS, CHN') 447 call trc_rst_dia_stat(zn_dms_chd(:,:), 'DMS, CHD') 448 call trc_rst_dia_stat(zn_dms_mld(:,:), 'DMS, MLD') 449 call trc_rst_dia_stat(zn_dms_qsr(:,:), 'DMS, QSR') 450 call trc_rst_dia_stat(zn_dms_din(:,:), 'DMS, DIN') 451 call trc_rst_dia_stat(zn_dms_srf(:,:), 'DMS surf') 452 call trc_rst_dia_stat(zn_co2_flx(:,:), 'CO2 flux') 453 !! 454 IF(lwp) WRITE(numout,*) ' MEDUSA averaged prop. for dust and iron dep.' 455 call trc_rst_dia_stat(dust(:,:), 'Dust dep') 456 call trc_rst_dia_stat(zirondep(:,:), 'Iron dep') 457 !! 458 !! 459 !! JPALM 14-06-2016 -- add Carbonate chenistry variables through the restart 460 !! -- needed for monthly call of carb-chem routine and better reproducibility 461 # if defined key_roam 462 IF(lwp) WRITE(numout,*) 'Carbonate chem variable - writing out ...' 463 CALL iom_rstput( kt, nitrst, numrtw, 'pH_3D' , f3_pH(:,:,:) ) 464 CALL iom_rstput( kt, nitrst, numrtw, 'h2CO3_3D', f3_h2co3(:,:,:) ) 465 CALL iom_rstput( kt, nitrst, numrtw, 'hCO3_3D' , f3_hco3(:,:,:) ) 466 CALL iom_rstput( kt, nitrst, numrtw, 'CO3_3D' , f3_co3(:,:,:) ) 467 CALL iom_rstput( kt, nitrst, numrtw, 'omcal_3D', f3_omcal(:,:,:) ) 468 CALL iom_rstput( kt, nitrst, numrtw, 'omarg_3D', f3_omarg(:,:,:) ) 469 CALL iom_rstput( kt, nitrst, numrtw, 'CCD_CAL' , f2_ccd_cal(:,:) ) 470 CALL iom_rstput( kt, nitrst, numrtw, 'CCD_ARG' , f2_ccd_arg(:,:) ) 471 !! 472 IF(lwp) WRITE(numout,*) ' MEDUSA averaged Carb-chem stats (min, max, sum) ...' 473 call trc_rst_dia_stat( f3_pH(:,:,1) ,'pH 3D surf') 474 call trc_rst_dia_stat( f3_h2co3(:,:,1),'h2CO3 3D surf') 475 call trc_rst_dia_stat( f3_hco3(:,:,1) ,'hCO3 3D surf' ) 476 call trc_rst_dia_stat( f3_co3(:,:,1) ,'CO3 3D surf' ) 477 call trc_rst_dia_stat( f3_omcal(:,:,1),'omcal 3D surf') 478 call trc_rst_dia_stat( f3_omarg(:,:,1),'omarg 3D surf') 479 call trc_rst_dia_stat( f2_ccd_cal(:,:),'CCD_CAL') 480 call trc_rst_dia_stat( f2_ccd_arg(:,:),'CCD_ARG') 481 !! 482 # endif 483 !! 484 #endif 485 ! 486 #if defined key_idtra 487 !! JPALM -- 05-01-2016 -- mv idtra and CFC restart reading and 488 !! writting here undre their key. 489 !! problems in CFC restart, maybe because of this... 490 !! and pb in idtra diag or diad-restart writing. 491 !!---------------------------------------------------------------------- 492 IF(lwp) WRITE(numout,*) ' IDTRA averaged properties - writing out ...' 493 CALL iom_rstput( kt, nitrst, numrtw, 'qint_IDTRA', qint_idtra(:,:,1) ) 494 !! 495 !! calculate stats on these fields 496 IF(lwp) WRITE(numout,*) ' IDTRA averaged properties stats (min, max, sum) ...' 497 call trc_rst_dia_stat(qint_idtra(:,:,1), 'qint_IDTRA') 498 #endif 499 ! 500 #if defined key_cfc 501 DO jl = 1, jp_cfc 502 jn = jp_cfc0 + jl - 1 503 IF(lwp) WRITE(numout,*) ' CFC averaged properties - writing out ...' 504 CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jl) ) 505 !! 506 !! calculate stats on these fields 507 IF(lwp) WRITE(numout,*) ' CFC averaged properties stats (min, max, sum) ...' 508 call trc_rst_dia_stat(qint_cfc(:,:,jl), 'qint_'//ctrcnm(jn)) 509 END DO 510 #endif 511 ! 512 145 513 IF( kt == nitrst ) THEN 146 514 CALL trc_rst_stat ! statistics … … 304 672 IF(lwp) WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax, zdrift 305 673 END DO 306 WRITE(numout,*)674 IF(lwp) WRITE(numout,*) 307 675 9000 FORMAT(' tracer nb :',i2,' name :',a10,' mean :',e18.10,' min :',e18.10, & 308 676 & ' max :',e18.10,' drift :',e18.10, ' %') 309 677 ! 310 678 END SUBROUTINE trc_rst_stat 679 680 681 SUBROUTINE trc_rst_tra_stat 682 !!---------------------------------------------------------------------- 683 !! *** trc_rst_tra_stat *** 684 !! 685 !! ** purpose : Compute tracers statistics - check where crazy values appears 686 !!---------------------------------------------------------------------- 687 INTEGER :: jk, jn 688 REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift 689 REAL(wp), DIMENSION(jpi,jpj) :: zvol 690 !!---------------------------------------------------------------------- 691 692 IF( lwp ) THEN 693 WRITE(numout,*) 694 WRITE(numout,*) ' ----SURFACE TRA STAT---- ' 695 WRITE(numout,*) 696 ENDIF 697 ! 698 zvol(:,:) = e1e2t(:,:) * fse3t_a(:,:,1) * tmask(:,:,1) 699 DO jn = 1, jptra 700 ztraf = glob_sum( tra(:,:,1,jn) * zvol(:,:) ) 701 zmin = MINVAL( tra(:,:,1,jn), mask= ((tmask(:,:,1).NE.0.)) ) 702 zmax = MAXVAL( tra(:,:,1,jn), mask= ((tmask(:,:,1).NE.0.)) ) 703 IF( lk_mpp ) THEN 704 CALL mpp_min( zmin ) ! min over the global domain 705 CALL mpp_max( zmax ) ! max over the global domain 706 END IF 707 zmean = ztraf / areatot 708 IF(lwp) WRITE(numout,9001) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax 709 END DO 710 IF(lwp) WRITE(numout,*) 711 9001 FORMAT(' tracer nb :',i2,' name :',a10,' mean :',e18.10,' min :',e18.10, & 712 & ' max :',e18.10) 713 ! 714 END SUBROUTINE trc_rst_tra_stat 715 716 717 718 SUBROUTINE trc_rst_dia_stat( dgtr, names) 719 !!---------------------------------------------------------------------- 720 !! *** trc_rst_dia_stat *** 721 !! 722 !! ** purpose : Compute tracers statistics 723 !!---------------------------------------------------------------------- 724 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: dgtr ! 2D diag var 725 CHARACTER(len=*) , INTENT(in) :: names ! 2D diag name 726 !!--------------------------------------------------------------------- 727 INTEGER :: jk, jn 728 REAL(wp) :: ztraf, zmin, zmax, zmean, areasf 729 REAL(wp), DIMENSION(jpi,jpj) :: zvol 730 !!---------------------------------------------------------------------- 731 732 IF( lwp ) WRITE(numout,*) 'STAT- ', names 733 ! 734 zvol(:,:) = e1e2t(:,:) * fse3t_a(:,:,1) * tmask(:,:,1) 735 ztraf = glob_sum( dgtr(:,:) * zvol(:,:) ) 736 areasf = glob_sum(e1e2t(:,:) * tmask(:,:,1) ) 737 zmin = MINVAL( dgtr(:,:), mask= ((tmask(:,:,1).NE.0.)) ) 738 zmax = MAXVAL( dgtr(:,:), mask= ((tmask(:,:,1).NE.0.)) ) 739 IF( lk_mpp ) THEN 740 CALL mpp_min( zmin ) ! min over the global domain 741 CALL mpp_max( zmax ) ! max over the global domain 742 END IF 743 zmean = ztraf / areatot 744 IF(lwp) WRITE(numout,9002) TRIM( names ), zmean, zmin, zmax 745 ! 746 IF(lwp) WRITE(numout,*) 747 9002 FORMAT(' tracer name :',a10,' mean :',e18.10,' min :',e18.10, & 748 & ' max :',e18.10 ) 749 ! 750 END SUBROUTINE trc_rst_dia_stat 751 311 752 312 753 #else -
branches/UKMO/dev_r5518_MEDUSA_optim_RH/NEMOGCM/NEMO/TOP_SRC/trcsms.F90
r7692 r7693 16 16 USE trc ! 17 17 USE trcsms_pisces ! PISCES biogeo-model 18 USE trcsms_medusa ! MEDUSA tracers 19 USE trcsms_idtra ! Idealize Tracer 18 20 USE trcsms_cfc ! CFC 11 & 12 19 21 USE trcsms_c14b ! C14b tracer 22 USE trcsms_age ! AGE tracer 20 23 USE trcsms_my_trc ! MY_TRC tracers 21 24 USE prtctl_trc ! Print control for debbuging … … 43 46 INTEGER, INTENT( in ) :: kt ! ocean time-step index 44 47 !! 48 INTEGER :: jn 45 49 CHARACTER (len=25) :: charout 46 50 !!--------------------------------------------------------------------- … … 49 53 ! 50 54 IF( lk_pisces ) CALL trc_sms_pisces ( kt ) ! main program of PISCES 55 IF( lk_medusa ) CALL trc_sms_medusa ( kt ) ! MEDUSA tracers 56 # if defined key_debug_medusa 57 IF(lwp) WRITE(numout,*) '--trcsms : MEDUSA OK -- next IDTRA -- ' 58 CALL flush(numout) 59 # endif 60 IF( lk_idtra ) CALL trc_sms_idtra ( kt ) ! radioactive decay of Id. tracer 61 # if defined key_debug_medusa 62 IF(lwp) WRITE(numout,*) '--trcsms : IDTRA OK -- next CFC -- ' 63 CALL flush(numout) 64 # endif 51 65 IF( lk_cfc ) CALL trc_sms_cfc ( kt ) ! surface fluxes of CFC 66 # if defined key_debug_medusa 67 IF(lwp) WRITE(numout,*) '--trcsms : CFC OK -- next C14 -- ' 68 CALL flush(numout) 69 # endif 52 70 IF( lk_c14b ) CALL trc_sms_c14b ( kt ) ! surface fluxes of C14 71 # if defined key_debug_medusa 72 IF(lwp) WRITE(numout,*) '--trcsms : C14 OK -- next C14 -- ' 73 CALL flush(numout) 74 # endif 75 IF( lk_age ) CALL trc_sms_age ( kt ) ! AGE tracer 76 # if defined key_debug_medusa 77 IF(lwp) WRITE(numout,*) '--trcsms : Age OK -- Continue -- ' 78 CALL flush(numout) 79 # endif 53 80 IF( lk_my_trc ) CALL trc_sms_my_trc ( kt ) ! MY_TRC tracers 54 81 -
branches/UKMO/dev_r5518_MEDUSA_optim_RH/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
r7692 r7693 87 87 tra(:,:,:,:) = 0.e0 88 88 ! 89 # if defined key_debug_medusa 90 IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp begins at kt =', kt 91 CALL flush(numout) 92 # endif 89 93 CALL trc_rst_opn ( kt ) ! Open tracer restart file 94 # if defined key_debug_medusa 95 CALL trc_rst_stat 96 CALL trc_rst_tra_stat 97 # endif 90 98 IF( lrst_trc ) CALL trc_rst_cal ( kt, 'WRITE' ) ! calendar 91 99 IF( lk_iomput ) THEN ; CALL trc_wri ( kt ) ! output of passive tracers with iom I/O manager … … 93 101 ENDIF 94 102 CALL trc_sms ( kt ) ! tracers: sinks and sources 103 # if defined key_debug_medusa 104 IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp SMS complete at kt =', kt 105 CALL trc_rst_stat 106 CALL trc_rst_tra_stat 107 CALL flush(numout) 108 # endif 95 109 CALL trc_trp ( kt ) ! transport of passive tracers 110 # if defined key_debug_medusa 111 IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp transport complete at kt =', kt 112 CALL trc_rst_stat 113 CALL trc_rst_tra_stat 114 CALL flush(numout) 115 # endif 96 116 IF( kt == nittrc000 ) THEN 97 117 CALL iom_close( numrtr ) ! close input tracer restart file … … 102 122 ! 103 123 IF( nn_dttrc /= 1 ) CALL trc_sub_reset( kt ) ! resetting physical variables when sub-stepping 124 # if defined key_debug_medusa 125 IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp ends at kt =', kt 126 CALL flush(numout) 127 # endif 104 128 ! 105 129 ENDIF -
branches/UKMO/dev_r5518_MEDUSA_optim_RH/NEMOGCM/NEMO/TOP_SRC/trcwri.F90
r7692 r7693 5 5 !!====================================================================== 6 6 !! History : 1.0 ! 2009-05 (C. Ethe) Original code 7 !! - ! 2014-06 (A. Yool, J. Palmieri) adding MEDUSA-2 7 8 !!---------------------------------------------------------------------- 8 9 #if defined key_top && defined key_iomput … … 21 22 USE trcwri_c14b 22 23 USE trcwri_my_trc 24 USE trcwri_medusa 25 USE trcwri_idtra 26 USE trcwri_age 23 27 24 28 IMPLICIT NONE … … 57 61 ! --------------------------------------- 58 62 IF( lk_pisces ) CALL trc_wri_pisces ! PISCES 63 IF( lk_medusa ) CALL trc_wri_medusa ! MESDUSA 64 IF( lk_idtra ) CALL trc_wri_idtra ! Idealize tracers 59 65 IF( lk_cfc ) CALL trc_wri_cfc ! surface fluxes of CFC 60 66 IF( lk_c14b ) CALL trc_wri_c14b ! surface fluxes of C14 67 IF( lk_age ) CALL trc_wri_age ! AGE tracer 61 68 IF( lk_my_trc ) CALL trc_wri_my_trc ! MY_TRC tracers 62 69 !
Note: See TracChangeset
for help on using the changeset viewer.