- Timestamp:
- 2020-09-14T17:40:34+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/TOP/PISCES/P4Z/p4zsms.F90 (modified) (25 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@13382 sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/PISCES/P4Z/p4zsms.F90
r10425 r13463 17 17 USE p4zlys ! Calcite saturation 18 18 USE p4zflx ! Gas exchange 19 USE p4z sbc! External source of nutrients19 USE p4zbc ! External source of nutrients 20 20 USE p4zsed ! Sedimentation 21 21 USE p4zint ! time interpolation … … 25 25 USE trdtrc ! TOP trends variables 26 26 USE sedmodel ! Sediment model 27 USE prtctl _trc! print control for debugging27 USE prtctl ! print control for debugging 28 28 29 29 IMPLICIT NONE … … 35 35 INTEGER :: numco2, numnut, numnit ! logical unit for co2 budget 36 36 REAL(wp) :: alkbudget, no3budget, silbudget, ferbudget, po4budget 37 REAL(wp) :: xfact 1, xfact2, xfact337 REAL(wp) :: xfact, xfact1, xfact2, xfact3 38 38 39 39 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xnegtr ! Array used to indicate negative tracer values 40 40 41 !! * Substitutions 42 # include "do_loop_substitute.h90" 43 # include "domzgr_substitute.h90" 41 44 !!---------------------------------------------------------------------- 42 45 !! NEMO/TOP 4.0 , NEMO Consortium (2018) … … 46 49 CONTAINS 47 50 48 SUBROUTINE p4z_sms( kt )51 SUBROUTINE p4z_sms( kt, Kbb, Kmm, Krhs ) 49 52 !!--------------------------------------------------------------------- 50 53 !! *** ROUTINE p4z_sms *** … … 58 61 !!--------------------------------------------------------------------- 59 62 ! 60 INTEGER, INTENT( in ) :: kt ! ocean time-step index 63 INTEGER, INTENT( in ) :: kt ! ocean time-step index 64 INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs ! time level index 61 65 !! 62 66 INTEGER :: ji, jj, jk, jnt, jn, jl 63 67 REAL(wp) :: ztra 64 68 CHARACTER (len=25) :: charout 69 REAL(wp), ALLOCATABLE, DIMENSION(:,: ) :: zw2d 70 REAL(wp), ALLOCATABLE, DIMENSION(:,:,: ) :: zw3d 71 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztrdt ! 4D workspace 72 65 73 !!--------------------------------------------------------------------- 66 74 ! … … 72 80 ! 73 81 IF( .NOT. ln_rsttr ) THEN 74 CALL p4z_che 75 CALL ahini_for_at( hi)! set PH at kt=nit00082 CALL p4z_che( Kbb, Kmm ) ! initialize the chemical constants 83 CALL ahini_for_at( hi, Kbb ) ! set PH at kt=nit000 76 84 t_oce_co2_flx_cum = 0._wp 77 85 ELSE 78 CALL p4z_rst( nittrc000, 'READ' ) !* read or initialize all required fields86 CALL p4z_rst( nittrc000, Kbb, Kmm, 'READ' ) !* read or initialize all required fields 79 87 ENDIF 80 88 ! 81 89 ENDIF 82 90 ! 83 IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 ) CALL p4z_dmp( kt ) ! Relaxation of some tracers 84 ! 85 rfact = r2dttrc 86 ! 87 IF( ( ln_top_euler .AND. kt == nittrc000 ) .OR. ( .NOT.ln_top_euler .AND. kt <= nittrc000 + nn_dttrc ) ) THEN 91 IF( ln_pisdmp .AND. MOD( kt - 1, nn_pisdmp ) == 0 ) CALL p4z_dmp( kt, Kbb, Kmm ) ! Relaxation of some tracers 92 ! 93 rfact = rDt_trc 94 ! 95 ! trends computation initialisation 96 IF( l_trdtrc ) THEN 97 ALLOCATE( ztrdt(jpi,jpj,jpk,jp_pisces) ) !* store now fields before applying the Asselin filter 98 ztrdt(:,:,:,:) = tr(:,:,:,:,Kmm) 99 ENDIF 100 ! 101 102 IF( ( ln_top_euler .AND. kt == nittrc000 ) .OR. ( .NOT.ln_top_euler .AND. kt <= nittrc000 + 1 ) ) THEN 88 103 rfactr = 1. / rfact 89 104 rfact2 = rfact / REAL( nrdttrc, wp ) 90 105 rfact2r = 1. / rfact2 91 106 xstep = rfact2 / rday ! Time step duration for biology 107 xfact = 1.e+3 * rfact2r 92 108 IF(lwp) WRITE(numout,*) 93 IF(lwp) WRITE(numout,*) ' Passive Tracer time step rfact = ', rfact, ' r dt = ', rdt109 IF(lwp) WRITE(numout,*) ' Passive Tracer time step rfact = ', rfact, ' rn_Dt = ', rn_Dt 94 110 IF(lwp) write(numout,*) ' PISCES Biology time step rfact2 = ', rfact2 95 111 IF(lwp) WRITE(numout,*) 96 112 ENDIF 97 113 98 IF( ( neuler == 0 .AND. kt == nittrc000 ).OR. ln_top_euler ) THEN114 IF( l_1st_euler .OR. ln_top_euler ) THEN 99 115 DO jn = jp_pcs0, jp_pcs1 ! SMS on tracer without Asselin time-filter 100 tr b(:,:,:,jn) = trn(:,:,:,jn)116 tr(:,:,:,jn,Kbb) = tr(:,:,:,jn,Kmm) 101 117 END DO 102 118 ENDIF 103 119 ! 104 IF( ll_ sbc ) CALL p4z_sbc( kt) ! external sources of nutrients120 IF( ll_bc ) CALL p4z_bc( kt, Kbb, Kmm, Krhs ) ! external sources of nutrients 105 121 ! 106 122 #if ! defined key_sed_off 107 CALL p4z_che 108 CALL p4z_int( kt )! computation of various rates for biogeochemistry123 CALL p4z_che( Kbb, Kmm ) ! computation of chemical constants 124 CALL p4z_int( kt, Kbb, Kmm ) ! computation of various rates for biogeochemistry 109 125 ! 110 126 DO jnt = 1, nrdttrc ! Potential time splitting if requested 111 127 ! 112 CALL p4z_bio( kt, jnt ) ! Biology113 CALL p4z_lys( kt, jnt ) ! Compute CaCO3 saturation114 CALL p4z_sed( kt, jnt ) ! Surface and Bottom boundary conditions115 CALL p4z_flx( kt, jnt ) ! Compute surface fluxes128 CALL p4z_bio( kt, jnt, Kbb, Kmm, Krhs ) ! Biology 129 CALL p4z_lys( kt, jnt, Kbb, Krhs ) ! Compute CaCO3 saturation 130 CALL p4z_sed( kt, jnt, Kbb, Kmm, Krhs ) ! Surface and Bottom boundary conditions 131 CALL p4z_flx( kt, jnt, Kbb, Kmm, Krhs ) ! Compute surface fluxes 116 132 ! 117 133 xnegtr(:,:,:) = 1.e0 118 134 DO jn = jp_pcs0, jp_pcs1 119 DO jk = 1, jpk 120 DO jj = 1, jpj 121 DO ji = 1, jpi 122 IF( ( trb(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) < 0.e0 ) THEN 123 ztra = ABS( trb(ji,jj,jk,jn) ) / ( ABS( tra(ji,jj,jk,jn) ) + rtrn ) 124 xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk), ztra ) 125 ENDIF 126 END DO 127 END DO 128 END DO 135 DO_3D( 1, 1, 1, 1, 1, jpk ) 136 IF( ( tr(ji,jj,jk,jn,Kbb) + tr(ji,jj,jk,jn,Krhs) ) < 0.e0 ) THEN 137 ztra = ABS( tr(ji,jj,jk,jn,Kbb) ) / ( ABS( tr(ji,jj,jk,jn,Krhs) ) + rtrn ) 138 xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk), ztra ) 139 ENDIF 140 END_3D 129 141 END DO 130 142 ! ! where at least 1 tracer concentration becomes negative 131 143 ! ! 132 144 DO jn = jp_pcs0, jp_pcs1 133 tr b(:,:,:,jn) = trb(:,:,:,jn) + xnegtr(:,:,:) * tra(:,:,:,jn)145 tr(:,:,:,jn,Kbb) = tr(:,:,:,jn,Kbb) + xnegtr(:,:,:) * tr(:,:,:,jn,Krhs) 134 146 END DO 135 147 ! 148 IF( iom_use( 'INTdtAlk' ) .OR. iom_use( 'INTdtDIC' ) .OR. iom_use( 'INTdtFer' ) .OR. & 149 & iom_use( 'INTdtDIN' ) .OR. iom_use( 'INTdtDIP' ) .OR. iom_use( 'INTdtSil' ) ) THEN 150 ! 151 ALLOCATE( zw3d(jpi,jpj,jpk), zw2d(jpi,jpj) ) 152 zw3d(:,:,jpk) = 0. 153 DO jk = 1, jpkm1 154 zw3d(:,:,jk) = xnegtr(:,:,jk) * xfact * e3t(:,:,jk,Kmm) * tmask(:,:,jk) 155 ENDDO 156 ! 157 zw2d(:,:) = 0. 158 DO jk = 1, jpkm1 159 zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr(:,:,jk,jptal,Krhs) 160 ENDDO 161 CALL iom_put( 'INTdtAlk', zw2d ) 162 ! 163 zw2d(:,:) = 0. 164 DO jk = 1, jpkm1 165 zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr(:,:,jk,jpdic,Krhs) 166 ENDDO 167 CALL iom_put( 'INTdtDIC', zw2d ) 168 ! 169 zw2d(:,:) = 0. 170 DO jk = 1, jpkm1 171 zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * rno3 * ( tr(:,:,jk,jpno3,Krhs) + tr(:,:,jk,jpnh4,Krhs) ) 172 ENDDO 173 CALL iom_put( 'INTdtDIN', zw2d ) 174 ! 175 zw2d(:,:) = 0. 176 DO jk = 1, jpkm1 177 zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * po4r * tr(:,:,jk,jppo4,Krhs) 178 ENDDO 179 CALL iom_put( 'INTdtDIP', zw2d ) 180 ! 181 zw2d(:,:) = 0. 182 DO jk = 1, jpkm1 183 zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr(:,:,jk,jpfer,Krhs) 184 ENDDO 185 CALL iom_put( 'INTdtFer', zw2d ) 186 ! 187 zw2d(:,:) = 0. 188 DO jk = 1, jpkm1 189 zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tr(:,:,jk,jpsil,Krhs) 190 ENDDO 191 CALL iom_put( 'INTdtSil', zw2d ) 192 ! 193 DEALLOCATE( zw3d, zw2d ) 194 ENDIF 195 ! 136 196 DO jn = jp_pcs0, jp_pcs1 137 tr a(:,:,:,jn) = 0._wp197 tr(:,:,:,jn,Krhs) = 0._wp 138 198 END DO 139 199 ! 140 200 IF( ln_top_euler ) THEN 141 201 DO jn = jp_pcs0, jp_pcs1 142 tr n(:,:,:,jn) = trb(:,:,:,jn)202 tr(:,:,:,jn,Kmm) = tr(:,:,:,jn,Kbb) 143 203 END DO 144 204 ENDIF 145 205 END DO 146 147 206 ! 148 207 IF( l_trdtrc ) THEN 149 208 DO jn = jp_pcs0, jp_pcs1 150 CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt ) ! save trends 209 ztrdt(:,:,:,jn) = ( tr(:,:,:,jn,Kbb) - ztrdt(:,:,:,jn) ) * rfactr 210 CALL trd_trc( tr(:,:,:,jn,Krhs), jn, jptra_sms, kt, Kmm ) ! save trends 151 211 END DO 212 DEALLOCATE( ztrdt ) 152 213 END IF 153 214 #endif … … 155 216 IF( ln_sediment ) THEN 156 217 ! 157 CALL sed_model( kt ) ! Main program of Sediment model218 CALL sed_model( kt, Kbb, Kmm, Krhs ) ! Main program of Sediment model 158 219 ! 159 220 IF( ln_top_euler ) THEN 160 221 DO jn = jp_pcs0, jp_pcs1 161 tr n(:,:,:,jn) = trb(:,:,:,jn)222 tr(:,:,:,jn,Kmm) = tr(:,:,:,jn,Kbb) 162 223 END DO 163 224 ENDIF … … 165 226 ENDIF 166 227 ! 167 IF( lrst_trc ) CALL p4z_rst( kt, 'WRITE' )!* Write PISCES informations in restart file168 ! 169 170 IF( lk_iomput .OR. ln_check_mass ) CALL p4z_chk_mass( kt )! Mass conservation checking171 172 IF( lwm .AND. kt == nittrc000 ) CALL FLUSH( numonp ) ! flush output namelist PISCES228 IF( lrst_trc ) CALL p4z_rst( kt, Kbb, Kmm, 'WRITE' ) !* Write PISCES informations in restart file 229 ! 230 231 IF( lk_iomput .OR. ln_check_mass ) CALL p4z_chk_mass( kt, Kmm ) ! Mass conservation checking 232 233 IF( lwm .AND. kt == nittrc000 ) CALL FLUSH( numonp ) ! flush output namelist PISCES 173 234 ! 174 235 IF( ln_timing ) CALL timing_stop('p4z_sms') … … 201 262 ENDIF 202 263 203 REWIND( numnatp_ref ) ! Namelist nampisbio in reference namelist : Pisces variables204 264 READ ( numnatp_ref, nampisbio, IOSTAT = ios, ERR = 901) 205 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisbio in reference namelist', lwp ) 206 REWIND( numnatp_cfg ) ! Namelist nampisbio in configuration namelist : Pisces variables 265 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisbio in reference namelist' ) 207 266 READ ( numnatp_cfg, nampisbio, IOSTAT = ios, ERR = 902 ) 208 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampisbio in configuration namelist' , lwp)267 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampisbio in configuration namelist' ) 209 268 IF(lwm) WRITE( numonp, nampisbio ) 210 269 ! … … 232 291 233 292 234 REWIND( numnatp_ref ) ! Namelist nampisdmp in reference namelist : Pisces damping235 293 READ ( numnatp_ref, nampisdmp, IOSTAT = ios, ERR = 905) 236 905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisdmp in reference namelist', lwp ) 237 REWIND( numnatp_cfg ) ! Namelist nampisdmp in configuration namelist : Pisces damping 294 905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisdmp in reference namelist' ) 238 295 READ ( numnatp_cfg, nampisdmp, IOSTAT = ios, ERR = 906 ) 239 906 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampisdmp in configuration namelist' , lwp)296 906 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampisdmp in configuration namelist' ) 240 297 IF(lwm) WRITE( numonp, nampisdmp ) 241 298 ! … … 247 304 ENDIF 248 305 249 REWIND( numnatp_ref ) ! Namelist nampismass in reference namelist : Pisces mass conservation check250 306 READ ( numnatp_ref, nampismass, IOSTAT = ios, ERR = 907) 251 907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismass in reference namelist', lwp ) 252 REWIND( numnatp_cfg ) ! Namelist nampismass in configuration namelist : Pisces mass conservation check 307 907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismass in reference namelist' ) 253 308 READ ( numnatp_cfg, nampismass, IOSTAT = ios, ERR = 908 ) 254 908 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampismass in configuration namelist' , lwp)309 908 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampismass in configuration namelist' ) 255 310 IF(lwm) WRITE( numonp, nampismass ) 256 311 … … 264 319 265 320 266 SUBROUTINE p4z_rst( kt, cdrw )321 SUBROUTINE p4z_rst( kt, Kbb, Kmm, cdrw ) 267 322 !!--------------------------------------------------------------------- 268 323 !! *** ROUTINE p4z_rst *** … … 275 330 !!--------------------------------------------------------------------- 276 331 INTEGER , INTENT(in) :: kt ! ocean time-step 332 INTEGER , INTENT(in) :: Kbb, Kmm ! time level indices 277 333 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 278 334 !!--------------------------------------------------------------------- … … 285 341 ! 286 342 IF( iom_varid( numrtr, 'PH', ldstop = .FALSE. ) > 0 ) THEN 287 CALL iom_get( numrtr, jpdom_auto glo, 'PH' , hi(:,:,:) )343 CALL iom_get( numrtr, jpdom_auto, 'PH' , hi(:,:,:) ) 288 344 ELSE 289 CALL p4z_che 290 CALL ahini_for_at( hi)291 ENDIF 292 CALL iom_get( numrtr, jpdom_auto glo, 'Silicalim', xksi(:,:) )345 CALL p4z_che( Kbb, Kmm ) ! initialize the chemical constants 346 CALL ahini_for_at( hi, Kbb ) 347 ENDIF 348 CALL iom_get( numrtr, jpdom_auto, 'Silicalim', xksi(:,:) ) 293 349 IF( iom_varid( numrtr, 'Silicamax', ldstop = .FALSE. ) > 0 ) THEN 294 CALL iom_get( numrtr, jpdom_auto glo, 'Silicamax' , xksimax(:,:) )350 CALL iom_get( numrtr, jpdom_auto, 'Silicamax' , xksimax(:,:) ) 295 351 ELSE 296 352 xksimax(:,:) = xksi(:,:) … … 305 361 IF( ln_p5z ) THEN 306 362 IF( iom_varid( numrtr, 'sized', ldstop = .FALSE. ) > 0 ) THEN 307 CALL iom_get( numrtr, jpdom_auto glo, 'sizep' , sizep(:,:,:) )308 CALL iom_get( numrtr, jpdom_auto glo, 'sizen' , sizen(:,:,:) )309 CALL iom_get( numrtr, jpdom_auto glo, 'sized' , sized(:,:,:) )363 CALL iom_get( numrtr, jpdom_auto, 'sizep' , sizep(:,:,:) ) 364 CALL iom_get( numrtr, jpdom_auto, 'sizen' , sizen(:,:,:) ) 365 CALL iom_get( numrtr, jpdom_auto, 'sized' , sized(:,:,:) ) 310 366 ELSE 311 367 sizep(:,:,:) = 1. … … 335 391 336 392 337 SUBROUTINE p4z_dmp( kt )393 SUBROUTINE p4z_dmp( kt, Kbb, Kmm ) 338 394 !!---------------------------------------------------------------------- 339 395 !! *** p4z_dmp *** … … 342 398 !!---------------------------------------------------------------------- 343 399 ! 344 INTEGER, INTENT( in ) :: kt ! time step 400 INTEGER, INTENT( in ) :: kt ! time step 401 INTEGER, INTENT( in ) :: Kbb, Kmm ! time level indices 345 402 ! 346 403 REAL(wp) :: alkmean = 2426. ! mean value of alkalinity ( Glodap ; for Goyet 2391. ) … … 363 420 zarea = 1._wp / glob_sum( 'p4zsms', cvol(:,:,:) ) * 1e6 364 421 365 zalksumn = glob_sum( 'p4zsms', tr n(:,:,:,jptal) * cvol(:,:,:) ) * zarea366 zpo4sumn = glob_sum( 'p4zsms', tr n(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r367 zno3sumn = glob_sum( 'p4zsms', tr n(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3368 zsilsumn = glob_sum( 'p4zsms', tr n(:,:,:,jpsil) * cvol(:,:,:) ) * zarea422 zalksumn = glob_sum( 'p4zsms', tr(:,:,:,jptal,Kmm) * cvol(:,:,:) ) * zarea 423 zpo4sumn = glob_sum( 'p4zsms', tr(:,:,:,jppo4,Kmm) * cvol(:,:,:) ) * zarea * po4r 424 zno3sumn = glob_sum( 'p4zsms', tr(:,:,:,jpno3,Kmm) * cvol(:,:,:) ) * zarea * rno3 425 zsilsumn = glob_sum( 'p4zsms', tr(:,:,:,jpsil,Kmm) * cvol(:,:,:) ) * zarea 369 426 370 427 IF(lwp) WRITE(numout,*) ' TALKN mean : ', zalksumn 371 tr n(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksumn428 tr(:,:,:,jptal,Kmm) = tr(:,:,:,jptal,Kmm) * alkmean / zalksumn 372 429 373 430 IF(lwp) WRITE(numout,*) ' PO4N mean : ', zpo4sumn 374 tr n(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sumn431 tr(:,:,:,jppo4,Kmm) = tr(:,:,:,jppo4,Kmm) * po4mean / zpo4sumn 375 432 376 433 IF(lwp) WRITE(numout,*) ' NO3N mean : ', zno3sumn 377 tr n(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sumn434 tr(:,:,:,jpno3,Kmm) = tr(:,:,:,jpno3,Kmm) * no3mean / zno3sumn 378 435 379 436 IF(lwp) WRITE(numout,*) ' SiO3N mean : ', zsilsumn 380 tr n(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsumn )437 tr(:,:,:,jpsil,Kmm) = MIN( 400.e-6,tr(:,:,:,jpsil,Kmm) * silmean / zsilsumn ) 381 438 ! 382 439 ! 383 440 IF( .NOT. ln_top_euler ) THEN 384 zalksumb = glob_sum( 'p4zsms', tr b(:,:,:,jptal) * cvol(:,:,:) ) * zarea385 zpo4sumb = glob_sum( 'p4zsms', tr b(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r386 zno3sumb = glob_sum( 'p4zsms', tr b(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3387 zsilsumb = glob_sum( 'p4zsms', tr b(:,:,:,jpsil) * cvol(:,:,:) ) * zarea441 zalksumb = glob_sum( 'p4zsms', tr(:,:,:,jptal,Kbb) * cvol(:,:,:) ) * zarea 442 zpo4sumb = glob_sum( 'p4zsms', tr(:,:,:,jppo4,Kbb) * cvol(:,:,:) ) * zarea * po4r 443 zno3sumb = glob_sum( 'p4zsms', tr(:,:,:,jpno3,Kbb) * cvol(:,:,:) ) * zarea * rno3 444 zsilsumb = glob_sum( 'p4zsms', tr(:,:,:,jpsil,Kbb) * cvol(:,:,:) ) * zarea 388 445 389 446 IF(lwp) WRITE(numout,*) ' ' 390 447 IF(lwp) WRITE(numout,*) ' TALKB mean : ', zalksumb 391 tr b(:,:,:,jptal) = trb(:,:,:,jptal) * alkmean / zalksumb448 tr(:,:,:,jptal,Kbb) = tr(:,:,:,jptal,Kbb) * alkmean / zalksumb 392 449 393 450 IF(lwp) WRITE(numout,*) ' PO4B mean : ', zpo4sumb 394 tr b(:,:,:,jppo4) = trb(:,:,:,jppo4) * po4mean / zpo4sumb451 tr(:,:,:,jppo4,Kbb) = tr(:,:,:,jppo4,Kbb) * po4mean / zpo4sumb 395 452 396 453 IF(lwp) WRITE(numout,*) ' NO3B mean : ', zno3sumb 397 tr b(:,:,:,jpno3) = trb(:,:,:,jpno3) * no3mean / zno3sumb454 tr(:,:,:,jpno3,Kbb) = tr(:,:,:,jpno3,Kbb) * no3mean / zno3sumb 398 455 399 456 IF(lwp) WRITE(numout,*) ' SiO3B mean : ', zsilsumb 400 tr b(:,:,:,jpsil) = MIN( 400.e-6,trb(:,:,:,jpsil) * silmean / zsilsumb )457 tr(:,:,:,jpsil,Kbb) = MIN( 400.e-6,tr(:,:,:,jpsil,Kbb) * silmean / zsilsumb ) 401 458 ENDIF 402 459 ENDIF … … 407 464 408 465 409 SUBROUTINE p4z_chk_mass( kt )466 SUBROUTINE p4z_chk_mass( kt, Kmm ) 410 467 !!---------------------------------------------------------------------- 411 468 !! *** ROUTINE p4z_chk_mass *** … … 415 472 !!--------------------------------------------------------------------- 416 473 INTEGER, INTENT( in ) :: kt ! ocean time-step index 474 INTEGER, INTENT( in ) :: Kmm ! time level indices 417 475 REAL(wp) :: zrdenittot, zsdenittot, znitrpottot 418 476 CHARACTER(LEN=100) :: cltxt … … 438 496 ! Compute the budget of NO3, ALK, Si, Fer 439 497 IF( ln_p4z ) THEN 440 zwork(:,:,:) = tr n(:,:,:,jpno3) + trn(:,:,:,jpnh4) &441 & + tr n(:,:,:,jpphy) + trn(:,:,:,jpdia) &442 & + tr n(:,:,:,jppoc) + trn(:,:,:,jpgoc) + trn(:,:,:,jpdoc) &443 & + tr n(:,:,:,jpzoo) + trn(:,:,:,jpmes)498 zwork(:,:,:) = tr(:,:,:,jpno3,Kmm) + tr(:,:,:,jpnh4,Kmm) & 499 & + tr(:,:,:,jpphy,Kmm) + tr(:,:,:,jpdia,Kmm) & 500 & + tr(:,:,:,jppoc,Kmm) + tr(:,:,:,jpgoc,Kmm) + tr(:,:,:,jpdoc,Kmm) & 501 & + tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) 444 502 ELSE 445 zwork(:,:,:) = tr n(:,:,:,jpno3) + trn(:,:,:,jpnh4) + trn(:,:,:,jpnph) &446 & + tr n(:,:,:,jpndi) + trn(:,:,:,jpnpi) &447 & + tr n(:,:,:,jppon) + trn(:,:,:,jpgon) + trn(:,:,:,jpdon) &448 & + ( tr n(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * no3rat3503 zwork(:,:,:) = tr(:,:,:,jpno3,Kmm) + tr(:,:,:,jpnh4,Kmm) + tr(:,:,:,jpnph,Kmm) & 504 & + tr(:,:,:,jpndi,Kmm) + tr(:,:,:,jpnpi,Kmm) & 505 & + tr(:,:,:,jppon,Kmm) + tr(:,:,:,jpgon,Kmm) + tr(:,:,:,jpdon,Kmm) & 506 & + ( tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) ) * no3rat3 449 507 ENDIF 450 508 ! … … 456 514 IF( iom_use( "ppo4tot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 457 515 IF( ln_p4z ) THEN 458 zwork(:,:,:) = tr n(:,:,:,jppo4) &459 & + tr n(:,:,:,jpphy) + trn(:,:,:,jpdia) &460 & + tr n(:,:,:,jppoc) + trn(:,:,:,jpgoc) + trn(:,:,:,jpdoc) &461 & + tr n(:,:,:,jpzoo) + trn(:,:,:,jpmes)516 zwork(:,:,:) = tr(:,:,:,jppo4,Kmm) & 517 & + tr(:,:,:,jpphy,Kmm) + tr(:,:,:,jpdia,Kmm) & 518 & + tr(:,:,:,jppoc,Kmm) + tr(:,:,:,jpgoc,Kmm) + tr(:,:,:,jpdoc,Kmm) & 519 & + tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) 462 520 ELSE 463 zwork(:,:,:) = tr n(:,:,:,jppo4) + trn(:,:,:,jppph) &464 & + tr n(:,:,:,jppdi) + trn(:,:,:,jpppi) &465 & + tr n(:,:,:,jppop) + trn(:,:,:,jpgop) + trn(:,:,:,jpdop) &466 & + ( tr n(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * po4rat3521 zwork(:,:,:) = tr(:,:,:,jppo4,Kmm) + tr(:,:,:,jppph,Kmm) & 522 & + tr(:,:,:,jppdi,Kmm) + tr(:,:,:,jpppi,Kmm) & 523 & + tr(:,:,:,jppop,Kmm) + tr(:,:,:,jpgop,Kmm) + tr(:,:,:,jpdop,Kmm) & 524 & + ( tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) ) * po4rat3 467 525 ENDIF 468 526 ! … … 473 531 ! 474 532 IF( iom_use( "psiltot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 475 zwork(:,:,:) = tr n(:,:,:,jpsil) + trn(:,:,:,jpgsi) + trn(:,:,:,jpdsi)533 zwork(:,:,:) = tr(:,:,:,jpsil,Kmm) + tr(:,:,:,jpgsi,Kmm) + tr(:,:,:,jpdsi,Kmm) 476 534 ! 477 535 silbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) ) … … 481 539 ! 482 540 IF( iom_use( "palktot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 483 zwork(:,:,:) = tr n(:,:,:,jpno3) * rno3 + trn(:,:,:,jptal) + trn(:,:,:,jpcal) * 2.541 zwork(:,:,:) = tr(:,:,:,jpno3,Kmm) * rno3 + tr(:,:,:,jptal,Kmm) + tr(:,:,:,jpcal,Kmm) * 2. 484 542 ! 485 543 alkbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) ) ! … … 489 547 ! 490 548 IF( iom_use( "pfertot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 491 zwork(:,:,:) = tr n(:,:,:,jpfer) + trn(:,:,:,jpnfe) + trn(:,:,:,jpdfe) &492 & + tr n(:,:,:,jpbfe) + trn(:,:,:,jpsfe) &493 & + ( tr n(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * ferat3549 zwork(:,:,:) = tr(:,:,:,jpfer,Kmm) + tr(:,:,:,jpnfe,Kmm) + tr(:,:,:,jpdfe,Kmm) & 550 & + tr(:,:,:,jpbfe,Kmm) + tr(:,:,:,jpsfe,Kmm) & 551 & + ( tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) ) * ferat3 494 552 ! 495 553 ferbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) )
Note: See TracChangeset
for help on using the changeset viewer.
