Changeset 5707
- Timestamp:
- 2015-08-26T14:18:46+02:00 (9 years ago)
- Location:
- branches/NERC/dev_r5107_NOC_MEDUSA/NEMOGCM/NEMO/TOP_SRC
- Files:
-
- 22 added
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/NERC/dev_r5107_NOC_MEDUSA/NEMOGCM/NEMO/TOP_SRC/par_trc.F90
r4529 r5707 15 15 USE par_cfc ! CFC 11 and 12 tracers 16 16 USE par_my_trc ! user defined passive tracers 17 USE par_medusa ! MEDUSA model 18 USE par_idtra ! Idealize tracer 17 19 18 20 IMPLICIT NONE … … 24 26 ! Passive tracers : Total size 25 27 ! --------------- ! 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 28 INTEGER, PUBLIC, PARAMETER :: jptra = jp_pisces + jp_cfc + jp_c14b + jp_my_trc + jp_medusa + jp_idtra 29 INTEGER, PUBLIC, PARAMETER :: jpdia2d = jp_pisces_2d + jp_cfc_2d + jp_c14b_2d + jp_my_trc_2d + jp_medusa_2d + jp_idtra_2d 30 INTEGER, PUBLIC, PARAMETER :: jpdia3d = jp_pisces_3d + jp_cfc_3d + jp_c14b_3d + jp_my_trc_3d + jp_medusa_3d + jp_idtra_3d 29 31 ! ! total number of sms diagnostic arrays 30 INTEGER, PUBLIC, PARAMETER :: jpdiabio = jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_my_trc_trd 32 INTEGER, PUBLIC, PARAMETER :: jpdiabio = jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_my_trc_trd + jp_medusa_trd + jp_idtra_trd 31 33 32 34 ! 1D configuration ("key_c1d") -
branches/NERC/dev_r5107_NOC_MEDUSA/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r4990 r5707 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 26 29 USE trcdta ! initialisation from files 27 30 USE daymod ! calendar manager … … 31 34 USE lib_mpp ! distribued memory computing library 32 35 USE sbc_oce 36 USE lib_fortran ! glob_sum 37 33 38 34 39 IMPLICIT NONE … … 61 66 CHARACTER (len=25) :: charout 62 67 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 4D workspace 68 # if defined key_debug_medusa 69 !!INTEGER :: globmask ! glob_sum tests for debug 70 REAL(wp) :: globtr, globvl, globtrvol, globmask ! glob_sum tests for debug 71 # endif 72 73 63 74 !!--------------------------------------------------------------------- 64 75 ! … … 75 86 #endif 76 87 88 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 89 !!!!! CHECK For MEDUSA 90 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 77 91 IF( ltrcdm2dc )CALL ctl_warn( ' Diurnal cycle on physics but not in PISCES or LOBSTER ' ) 78 92 … … 100 114 IF( lk_c14b ) CALL trc_ini_c14b ! C14 bomb tracer 101 115 IF( lk_my_trc ) CALL trc_ini_my_trc ! MY_TRC tracers 116 IF( lk_medusa ) CALL trc_ini_medusa ! MEDUSA tracers 117 IF( lk_idtra ) CALL trc_ini_idtra ! Idealize tracers 118 119 # if defined key_debug_medusa 120 IF (lwp) write (numout,*) '------------------------------' 121 IF (lwp) write (numout,*) 'Jpalm - debug' 122 IF (lwp) write (numout,*) ' in trc_init' 123 IF (lwp) write (numout,*) ' sms init OK' 124 IF (lwp) write (numout,*) ' next: open tracer.stat' 125 IF (lwp) write (numout,*) ' ' 126 CALL flush(numout) 127 # endif 102 128 103 129 IF( lwp ) THEN … … 107 133 ENDIF 108 134 109 IF( ln_trcdta ) CALL trc_dta_init(jptra) 110 135 # if defined key_debug_medusa 136 IF (lwp) write (numout,*) '------------------------------' 137 IF (lwp) write (numout,*) 'Jpalm - debug' 138 IF (lwp) write (numout,*) ' in trc_init' 139 IF (lwp) write (numout,*) 'open tracer.stat -- OK' 140 IF (lwp) write (numout,*) ' ' 141 CALL flush(numout) 142 # endif 143 144 145 IF( ln_trcdta ) THEN 146 #if defined key_medusa 147 IF(lwp) WRITE(numout,*) 'AXY: calling trc_dta_init' 148 IF(lwp) CALL flush(numout) 149 #endif 150 CALL trc_dta_init(jptra) 151 ENDIF 111 152 112 153 IF( ln_rsttr ) THEN 113 154 ! 155 #if defined key_medusa 156 IF(lwp) WRITE(numout,*) 'AXY: calling trc_rst_read' 157 IF(lwp) CALL flush(numout) 158 #endif 114 159 CALL trc_rst_read ! restart from a file 115 160 ! … … 118 163 IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN ! Initialisation of tracer from a file that may also be used for damping 119 164 ! 165 #if defined key_medusa 166 IF(lwp) WRITE(numout,*) 'AXY: calling wrk_alloc' 167 IF(lwp) CALL flush(numout) 168 #endif 120 169 CALL wrk_alloc( jpi, jpj, jpk, ztrcdta ) ! Memory allocation 121 170 ! 171 #if defined key_medusa 172 IF(lwp) WRITE(numout,*) 'AXY: calling trc_dta' 173 IF(lwp) CALL flush(numout) 174 #endif 122 175 DO jn = 1, jptra 123 176 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file … … 126 179 ztrcdta(:,:,:) = sf_trcdta(jl)%fnow(:,:,:) 127 180 trn(:,:,:,jn) = ztrcdta(:,:,:) * tmask(:,:,:) 128 IF( .NOT.ln_trcdmp .AND. .NOT. ln_trcdmp_clo ) THEN !== deallocate data structure ==!181 IF( .NOT.ln_trcdmp .AND. .NOT. ln_trcdmp_clo ) THEN !== deallocate data structure ==! 129 182 ! (data used only for initialisation) 130 183 IF(lwp) WRITE(numout,*) 'trc_dta: deallocate data arrays as they are only used to initialize the run' … … 135 188 ENDIF 136 189 ENDDO 190 #if defined key_medusa 191 IF(lwp) WRITE(numout,*) 'AXY: calling wrk_dealloc' 192 IF(lwp) CALL flush(numout) 193 #endif 137 194 CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta ) 138 195 ENDIF 139 196 ! 197 # if defined key_debug_medusa 198 IF (lwp) write (numout,*) '------------------------------' 199 IF (lwp) write (numout,*) 'Jpalm - debug' 200 IF (lwp) write (numout,*) ' in trc_init' 201 IF (lwp) write (numout,*) ' before trb = trn' 202 IF (lwp) write (numout,*) ' ' 203 CALL flush(numout) 204 # endif 205 ! 140 206 trb(:,:,:,:) = trn(:,:,:,:) 207 ! 208 # if defined key_debug_medusa 209 IF (lwp) write (numout,*) '------------------------------' 210 IF (lwp) write (numout,*) 'Jpalm - debug' 211 IF (lwp) write (numout,*) ' in trc_init' 212 IF (lwp) write (numout,*) ' trb = trn -- OK' 213 IF (lwp) write (numout,*) ' ' 214 CALL flush(numout) 215 # endif 141 216 ! 142 217 ENDIF … … 145 220 IF( ln_zps .AND. .NOT. lk_c1d ) & ! Partial steps: before horizontal gradient of passive 146 221 & CALL zps_hde( nit000, jptra, trn, pgtu=gtru, pgtv=gtrv, sgtu=gtrui, sgtv=gtrvi ) ! tracers at the bottom ocean level 147 222 ! 223 # if defined key_debug_medusa 224 IF (lwp) write (numout,*) '------------------------------' 225 IF (lwp) write (numout,*) 'Jpalm - debug' 226 IF (lwp) write (numout,*) ' in trc_init' 227 IF (lwp) write (numout,*) ' partial step -- OK' 228 IF (lwp) write (numout,*) ' ' 229 CALL flush(numout) 230 # endif 148 231 ! 149 232 IF( nn_dttrc /= 1 ) CALL trc_sub_ini ! Initialize variables for substepping passive tracers 150 233 ! 151 234 # if defined key_debug_medusa 235 IF (lwp) write (numout,*) '------------------------------' 236 IF (lwp) write (numout,*) 'Jpalm - debug' 237 IF (lwp) write (numout,*) ' in trc_init' 238 IF (lwp) write (numout,*) ' before initiate tracer contents' 239 IF (lwp) write (numout,*) ' ' 240 CALL flush(numout) 241 # endif 242 ! 243 # if defined key_debug_medusa 244 write (*,*) narea,' TRCINI ','Jpalm - debug' 245 write (*,*) narea,' TRCINI ','LN_CTL = TRUE ' 246 write (*,*) narea,' TRCINI ','---------------------------------' 247 CALL flush(numout) 248 globmask = glob_sum( tmask(:,:,:)) 249 IF (lwp) write (numout,*) 'glob_sum test, sum tmask : ',globmask 250 # endif 251 ! 152 252 trai(:) = 0._wp ! initial content of all tracers 153 253 DO jn = 1, jptra 254 # if defined key_debug_medusa 255 globtr = glob_sum( trn(:,:,:,jn)) 256 globvl = glob_sum( cvol(:,:,:)) 257 globtrvol = glob_sum( trn(:,:,:,jn) * cvol(:,:,:)) 258 ! 259 IF (lwp) write (numout,*) 'var number : ',jn 260 CALL flush(numout) 261 IF (lwp) write (numout,*) 'trai(jn) before - should be 0 - ',trai(jn) 262 CALL flush(numout) 263 IF (lwp) write (numout,*) 'global Ocean volume : ',globvl 264 CALL flush(numout) 265 IF (lwp) write (numout,*) 'global sum of tracer : ',globtr 266 CALL flush(numout) 267 IF (lwp) write (numout,*) 'global weighted tracer : ',globtrvol 268 CALL flush(numout) 269 # endif 154 270 trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:) ) 155 271 END DO … … 162 278 WRITE(numout,*) ' *** Total inital content of all tracers ' 163 279 WRITE(numout,*) 280 # if defined key_debug_medusa 281 CALL flush(numout) 282 # endif 283 ! 284 # if defined key_debug_medusa 285 WRITE(numout,*) ' litle check : ', ctrcnm(1) 286 CALL flush(numout) 287 # endif 164 288 DO jn = 1, jptra 165 289 WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn) … … 174 298 CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 175 299 ENDIF 300 301 IF(lwp) WRITE(numout,*) 302 IF(lwp) WRITE(numout,*) 'trc_init : passive tracer set up completed' 303 IF(lwp) WRITE(numout,*) '~~~~~~~' 304 IF(lwp) CALL flush(numout) 305 176 306 9000 FORMAT(' tracer nb : ',i2,' name :',a10,' initial content :',e18.10) 177 307 ! -
branches/NERC/dev_r5107_NOC_MEDUSA/NEMOGCM/NEMO/TOP_SRC/trcnam.F90
r4990 r5707 25 25 USE trcnam_c14b ! C14 SMS namelist 26 26 USE trcnam_my_trc ! MY_TRC SMS namelist 27 USE trcnam_medusa ! MEDUSA namelist 28 USE trcnam_idtra ! Idealise tracer namelist 27 29 USE trd_oce 28 30 USE trdtrc_oce … … 56 58 !! ( (PISCES, CFC, MY_TRC ) 57 59 !!--------------------------------------------------------------------- 58 INTEGER :: jn ! dummy loop indice60 INTEGER :: jn, jk ! dummy loop indice 59 61 ! ! Parameters of the run 60 62 IF( .NOT. lk_offline ) CALL trc_nam_run 61 63 62 64 ! ! passive tracer informations 65 # if defined key_debug_medusa 66 CALL flush(numout) 67 IF (lwp) write (numout,*) '------------------------------' 68 IF (lwp) write (numout,*) 'Jpalm - debug' 69 IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_trc' 70 IF (lwp) write (numout,*) ' ' 71 # endif 72 ! 63 73 CALL trc_nam_trc 64 74 65 75 ! ! Parameters of additional diagnostics 76 # if defined key_debug_medusa 77 CALL flush(numout) 78 IF (lwp) write (numout,*) '------------------------------' 79 IF (lwp) write (numout,*) 'Jpalm - debug' 80 IF (lwp) write (numout,*) 'CALL trc_nam_trc -- OK' 81 IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_dia' 82 IF (lwp) write (numout,*) ' ' 83 # endif 84 ! 85 66 86 CALL trc_nam_dia 67 87 68 88 ! ! namelist of transport 89 # if defined key_debug_medusa 90 CALL flush(numout) 91 IF (lwp) write (numout,*) '------------------------------' 92 IF (lwp) write (numout,*) 'Jpalm - debug' 93 IF (lwp) write (numout,*) 'CALL trc_nam_dia -- OK' 94 IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_trp' 95 IF (lwp) write (numout,*) ' ' 96 # endif 97 ! 69 98 CALL trc_nam_trp 99 ! 100 # if defined key_debug_medusa 101 CALL flush(numout) 102 IF (lwp) write (numout,*) '------------------------------' 103 IF (lwp) write (numout,*) 'Jpalm - debug' 104 IF (lwp) write (numout,*) 'CALL trc_nam_trp -- OK' 105 IF (lwp) write (numout,*) 'continue trc_nam ' 106 IF (lwp) write (numout,*) ' ' 107 CALL flush(numout) 108 # endif 109 ! 70 110 71 111 … … 89 129 END DO 90 130 WRITE(numout,*) ' ' 131 # if defined key_debug_medusa 132 CALL flush(numout) 133 # endif 91 134 ENDIF 92 135 … … 107 150 WRITE(numout,*) 108 151 ENDIF 109 ENDIF 110 152 # if defined key_debug_medusa 153 CALL flush(numout) 154 # endif 155 ENDIF 156 157 # if defined key_debug_medusa 158 DO jk = 1, jpk 159 WRITE(numout,*) ' level number: ', jk, 'rdttrc: ',rdttrc(jk),'rdttra: ', rdttra(jk),'nn_dttrc: ', nn_dttrc 160 END DO 161 CALL flush(numout) 162 # endif 111 163 112 164 rdttrc(:) = rdttra(:) * FLOAT( nn_dttrc ) ! vertical profile of passive tracer time-step … … 116 168 WRITE(numout,*) ' Passive Tracer time step rdttrc = ', rdttrc(1) 117 169 WRITE(numout,*) 170 # if defined key_debug_medusa 171 CALL flush(numout) 172 # endif 118 173 ENDIF 119 174 … … 143 198 IF( ln_trdtrc(jn) ) WRITE(numout,*) ' compute ML trends for tracer number :', jn 144 199 END DO 200 WRITE(numout,*) ' ' 201 CALL flush(numout) 145 202 ENDIF 146 203 #endif 147 204 205 # if defined key_debug_medusa 206 CALL flush(numout) 207 IF (lwp) write (numout,*) '------------------------------' 208 IF (lwp) write (numout,*) 'Jpalm - debug' 209 IF (lwp) write (numout,*) 'Will now read SMS namelists : ' 210 IF (lwp) write (numout,*) ' ' 211 # endif 212 ! 148 213 149 214 ! namelist of SMS … … 152 217 ELSE ; IF(lwp) WRITE(numout,*) ' PISCES not used' 153 218 ENDIF 154 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,*) 'CALL trc_nam_pisces -- OK' 225 IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_medusa' 226 IF (lwp) write (numout,*) ' ' 227 # endif 228 ! 229 IF( lk_medusa ) THEN ; CALL trc_nam_medusa ! MEDUSA tracers 230 ELSE ; IF(lwp) WRITE(numout,*) ' MEDUSA not used' 231 ENDIF 232 ! 233 # if defined key_debug_medusa 234 CALL flush(numout) 235 IF (lwp) write (numout,*) '------------------------------' 236 IF (lwp) write (numout,*) 'Jpalm - debug' 237 IF (lwp) write (numout,*) 'CALL trc_nam_medusa -- OK' 238 IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_idtra' 239 IF (lwp) write (numout,*) ' ' 240 # endif 241 ! 242 IF( lk_idtra ) THEN ; CALL trc_nam_idtra ! Idealize tracers 243 ELSE ; IF(lwp) WRITE(numout,*) ' Idealize tracers not used' 244 ENDIF 245 ! 246 # if defined key_debug_medusa 247 CALL flush(numout) 248 IF (lwp) write (numout,*) '------------------------------' 249 IF (lwp) write (numout,*) 'Jpalm - debug' 250 IF (lwp) write (numout,*) 'CALL trc_nam_idtra -- OK' 251 IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_cfc' 252 IF (lwp) write (numout,*) ' ' 253 # endif 254 ! 155 255 IF( lk_cfc ) THEN ; CALL trc_nam_cfc ! CFC tracers 156 256 ELSE ; IF(lwp) WRITE(numout,*) ' CFC not used' 157 257 ENDIF 158 258 ! 259 # if defined key_debug_medusa 260 CALL flush(numout) 261 IF (lwp) write (numout,*) '------------------------------' 262 IF (lwp) write (numout,*) 'Jpalm - debug' 263 IF (lwp) write (numout,*) 'CALL trc_nam_cfc -- OK' 264 IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_c14b' 265 IF (lwp) write (numout,*) ' ' 266 # endif 267 ! 159 268 IF( lk_c14b ) THEN ; CALL trc_nam_c14b ! C14 bomb tracers 160 269 ELSE ; IF(lwp) WRITE(numout,*) ' C14 not used' … … 165 274 ENDIF 166 275 ! 276 IF(lwp) CALL flush(numout) 167 277 END SUBROUTINE trc_nam 168 278 … … 211 321 WRITE(numout,*) ' Use euler integration for TRC (y/n) ln_top_euler = ', ln_top_euler 212 322 WRITE(numout,*) ' ' 323 CALL flush(numout) 213 324 ENDIF 214 325 ! … … 251 362 ln_trc_wri(jn) = sn_tracer(jn)%llsave 252 363 END DO 253 364 IF(lwp) CALL flush(numout) 365 254 366 END SUBROUTINE trc_nam_trc 255 367 … … 302 414 WRITE(numout,*) ' frequency of outputs for biological trends nn_writebio = ', nn_writebio 303 415 WRITE(numout,*) ' ' 304 ENDIF 305 306 IF( ln_diatrc .AND. .NOT. lk_iomput ) THEN 416 CALL flush(numout) 417 ENDIF 418 !! 419 !! JPALM -- 17-07-2015 -- 420 !! MEDUSA is not yet up-to-date with the iom server. 421 !! we use it for the main tracer, but not fully with diagnostics. 422 !! will have to adapt it properly when visiting Christian Ethee 423 !! for now, we change 424 !! IF( ln_diatrc .AND. .NOT. lk_iomput ) THEN 425 !! to : 426 !! 427 IF( ( ln_diatrc .AND. .NOT. lk_iomput ) .OR. ( ln_diatrc .AND. lk_medusa ) ) THEN 307 428 ALLOCATE( trc2d(jpi,jpj,jpdia2d), trc3d(jpi,jpj,jpk,jpdia3d), & 308 429 & ctrc2d(jpdia2d), ctrc2l(jpdia2d), ctrc2u(jpdia2d) , & -
branches/NERC/dev_r5107_NOC_MEDUSA/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
r4990 r5707 28 28 USE iom 29 29 USE daymod 30 !! AXY (05/11/13): need these for MEDUSA to input/output benthic reservoirs 31 USE sms_medusa 32 USE trcsms_medusa 33 !! 30 34 IMPLICIT NONE 31 35 PRIVATE … … 88 92 SUBROUTINE trc_rst_read 89 93 !!---------------------------------------------------------------------- 90 !! *** trc_r st_opn ***94 !! *** trc_read_opn *** 91 95 !! 92 96 !! ** purpose : read passive tracer fields in restart files 93 97 !!---------------------------------------------------------------------- 94 98 INTEGER :: jn 99 !! AXY (05/11/13): temporary variables 100 REAL(wp) :: fq0,fq1,fq2 95 101 96 102 !!---------------------------------------------------------------------- … … 108 114 CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 109 115 END DO 116 117 !! AXY (09/06/14): the ARCHER version of MEDUSA-2 does not include an equivalent 118 !! call to MEDUSA-2 at this point; this suggests that the FCM 119 !! version of NEMO date significantly earlier than the current 120 !! version 121 122 #if defined key_medusa 123 !! AXY (13/01/12): check if the restart contains sediment fields; 124 !! this is only relevant for simulations that include 125 !! biogeochemistry and are restarted from earlier runs 126 !! in which there was no sediment component 127 !! 128 IF( iom_varid( numrtr, 'B_SED_N', ldstop = .FALSE. ) > 0 ) THEN 129 !! YES; in which case read them 130 !! 131 IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields present - reading in ...' 132 CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_N', zb_sed_n(:,:) ) 133 CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_N', zn_sed_n(:,:) ) 134 CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_FE', zb_sed_fe(:,:) ) 135 CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_FE', zn_sed_fe(:,:) ) 136 CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_SI', zb_sed_si(:,:) ) 137 CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_SI', zn_sed_si(:,:) ) 138 CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_C', zb_sed_c(:,:) ) 139 CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_C', zn_sed_c(:,:) ) 140 CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_CA', zb_sed_ca(:,:) ) 141 CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_CA', zn_sed_ca(:,:) ) 142 ELSE 143 !! NO; in which case set them to zero 144 !! 145 IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields absent - setting to zero ...' 146 zb_sed_n(:,:) = 0.0 !! organic N 147 zn_sed_n(:,:) = 0.0 148 zb_sed_fe(:,:) = 0.0 !! organic Fe 149 zn_sed_fe(:,:) = 0.0 150 zb_sed_si(:,:) = 0.0 !! inorganic Si 151 zn_sed_si(:,:) = 0.0 152 zb_sed_c(:,:) = 0.0 !! organic C 153 zn_sed_c(:,:) = 0.0 154 zb_sed_ca(:,:) = 0.0 !! inorganic C 155 zn_sed_ca(:,:) = 0.0 156 ENDIF 157 !! 158 !! calculate stats on these fields 159 IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...' 160 fq0 = MINVAL(zn_sed_n(:,:)) 161 fq1 = MAXVAL(zn_sed_n(:,:)) 162 fq2 = SUM(zn_sed_n(:,:)) 163 if (lwp) write (numout,'(a,3f15.5)') 'Sediment N ', & 164 & fq0, fq1, fq2 165 fq0 = MINVAL(zn_sed_fe(:,:)) 166 fq1 = MAXVAL(zn_sed_fe(:,:)) 167 fq2 = SUM(zn_sed_fe(:,:)) 168 if (lwp) write (numout,'(a,3f15.5)') 'Sediment Fe ', & 169 & fq0, fq1, fq2 170 fq0 = MINVAL(zn_sed_si(:,:)) 171 fq1 = MAXVAL(zn_sed_si(:,:)) 172 fq2 = SUM(zn_sed_si(:,:)) 173 if (lwp) write (numout,'(a,3f15.5)') 'Sediment Si ', & 174 & fq0, fq1, fq2 175 fq0 = MINVAL(zn_sed_c(:,:)) 176 fq1 = MAXVAL(zn_sed_c(:,:)) 177 fq2 = SUM(zn_sed_c(:,:)) 178 if (lwp) write (numout,'(a,3f15.5)') 'Sediment C ', & 179 & fq0, fq1, fq2 180 fq0 = MINVAL(zn_sed_ca(:,:)) 181 fq1 = MAXVAL(zn_sed_ca(:,:)) 182 fq2 = SUM(zn_sed_ca(:,:)) 183 if (lwp) write (numout,'(a,3f15.5)') 'Sediment Ca ', & 184 & fq0, fq1, fq2 185 #endif 186 110 187 ! 111 188 END SUBROUTINE trc_rst_read … … 121 198 INTEGER :: jn 122 199 REAL(wp) :: zarak0 200 !! AXY (05/11/13): temporary variables 201 REAL(wp) :: fq0,fq1,fq2 123 202 !!---------------------------------------------------------------------- 124 203 ! … … 133 212 CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 134 213 END DO 214 215 !! AXY (09/06/14): the ARCHER version of MEDUSA-2 does not include an equivalent 216 !! call to MEDUSA-2 at this point; this suggests that the FCM 217 !! version of NEMO date significantly earlier than the current 218 !! version 219 220 #if defined key_medusa 221 !! AXY (13/01/12): write out "before" and "now" state of seafloor 222 !! sediment pools into restart; this happens 223 !! whether or not the pools are to be used by 224 !! MEDUSA (which is controlled by a switch in the 225 !! namelist_top file) 226 !! 227 IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields - writing out ...' 228 CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_N', zb_sed_n(:,:) ) 229 CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_N', zn_sed_n(:,:) ) 230 CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_FE', zb_sed_fe(:,:) ) 231 CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_FE', zn_sed_fe(:,:) ) 232 CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_SI', zb_sed_si(:,:) ) 233 CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_SI', zn_sed_si(:,:) ) 234 CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_C', zb_sed_c(:,:) ) 235 CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_C', zn_sed_c(:,:) ) 236 CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_CA', zb_sed_ca(:,:) ) 237 CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_CA', zn_sed_ca(:,:) ) 238 !! 239 !! calculate stats on these fields 240 IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...' 241 fq0 = MINVAL(zn_sed_n(:,:)) 242 fq1 = MAXVAL(zn_sed_n(:,:)) 243 fq2 = SUM(zn_sed_n(:,:)) 244 if (lwp) write (numout,'(a,3f15.5)') 'Sediment N ', & 245 & fq0, fq1, fq2 246 fq0 = MINVAL(zn_sed_fe(:,:)) 247 fq1 = MAXVAL(zn_sed_fe(:,:)) 248 fq2 = SUM(zn_sed_fe(:,:)) 249 if (lwp) write (numout,'(a,3f15.5)') 'Sediment Fe ', & 250 & fq0, fq1, fq2 251 fq0 = MINVAL(zn_sed_si(:,:)) 252 fq1 = MAXVAL(zn_sed_si(:,:)) 253 fq2 = SUM(zn_sed_si(:,:)) 254 if (lwp) write (numout,'(a,3f15.5)') 'Sediment Si ', & 255 & fq0, fq1, fq2 256 fq0 = MINVAL(zn_sed_c(:,:)) 257 fq1 = MAXVAL(zn_sed_c(:,:)) 258 fq2 = SUM(zn_sed_c(:,:)) 259 if (lwp) write (numout,'(a,3f15.5)') 'Sediment C ', & 260 & fq0, fq1, fq2 261 fq0 = MINVAL(zn_sed_ca(:,:)) 262 fq1 = MAXVAL(zn_sed_ca(:,:)) 263 fq2 = SUM(zn_sed_ca(:,:)) 264 if (lwp) write (numout,'(a,3f15.5)') 'Sediment Ca ', & 265 & fq0, fq1, fq2 266 #endif 267 135 268 ! 136 269 IF( kt == nitrst ) THEN -
branches/NERC/dev_r5107_NOC_MEDUSA/NEMOGCM/NEMO/TOP_SRC/trcsms.F90
r3680 r5707 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 … … 49 51 ! 50 52 IF( lk_pisces ) CALL trc_sms_pisces ( kt ) ! main program of PISCES 53 IF( lk_medusa ) CALL trc_sms_medusa ( kt ) ! MEDUSA tracers 54 IF( lk_idtra ) CALL trc_sms_idtra ( kt ) ! radioactive decay of Id. tracer 51 55 IF( lk_cfc ) CALL trc_sms_cfc ( kt ) ! surface fluxes of CFC 52 56 IF( lk_c14b ) CALL trc_sms_c14b ( kt ) ! surface fluxes of C14 -
branches/NERC/dev_r5107_NOC_MEDUSA/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
r4990 r5707 88 88 tra(:,:,:,:) = 0.e0 89 89 ! 90 # if defined key_debug_medusa 91 IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp begins at kt =', kt 92 CALL flush(numout) 93 # endif 90 94 CALL trc_rst_opn ( kt ) ! Open tracer restart file 91 95 IF( lrst_trc ) CALL trc_rst_cal ( kt, 'WRITE' ) ! calendar … … 94 98 ENDIF 95 99 CALL trc_sms ( kt ) ! tracers: sinks and sources 100 # if defined key_debug_medusa 101 IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp SMS complete at kt =', kt 102 CALL flush(numout) 103 # endif 96 104 CALL trc_trp ( kt ) ! transport of passive tracers 105 # if defined key_debug_medusa 106 IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp transport complete at kt =', kt 107 CALL flush(numout) 108 # endif 97 109 IF( kt == nittrc000 ) THEN 98 110 CALL iom_close( numrtr ) ! close input tracer restart file … … 103 115 ! 104 116 IF( nn_dttrc /= 1 ) CALL trc_sub_reset( kt ) ! resetting physical variables when sub-stepping 117 # if defined key_debug_medusa 118 IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp ends at kt =', kt 119 CALL flush(numout) 120 # endif 105 121 ! 106 122 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.