Changeset 763 for branches/dev_001_GM/NEMO/TOP_SRC/trcrst.F90
- Timestamp:
- 2007-12-13T14:52:50+01:00 (16 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_001_GM/NEMO/TOP_SRC/trcrst.F90
r730 r763 1 1 MODULE trcrst 2 2 !!====================================================================== 3 !! 4 !! *** MODULE trcrst *** 5 !! 6 !! Read the restart files for passive tracers 7 !! 3 !! *** MODULE trcrst *** 4 !! TOP : create, write, read the restart files for passive tracers 8 5 !!====================================================================== 9 !! TOP 1.0, LOCEAN-IPSL (2005) 10 !! $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/trcrst.F90,v 1.11 2007/10/17 14:48:56 opalod Exp $ 11 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 12 !!---------------------------------------------------------------------- 13 #if defined key_passivetrc 14 !!---------------------------------------------------------------------- 15 !! * Modules used 16 !! ============== 6 !! History : 1.0 ! 2007-02 (C. Ethe) adaptation from the ocean 7 !!---------------------------------------------------------------------- 8 #if defined key_passivetrc 9 !!---------------------------------------------------------------------- 10 !! 'key_passivetrc' Passive tracers 11 !!---------------------------------------------------------------------- 12 !! trc_rst_opn : open restart file 13 !! trc_rst_read : read restart file 14 !! trc_rst_wri : write restart file 15 !!---------------------------------------------------------------------- 17 16 USE oce_trc 18 17 USE trc … … 25 24 PRIVATE 26 25 27 !! * Accessibility 28 PUBLIC trc_rst_opn 29 PUBLIC trc_rst_read 30 PUBLIC trc_rst_wri 31 32 !! * Module variables 26 PUBLIC trc_rst_opn ! called by ??? 27 PUBLIC trc_rst_read ! called by ??? 28 PUBLIC trc_rst_wri ! called by ??? 29 33 30 LOGICAL, PUBLIC :: lrst_trc !: logical to control the trc restart write 34 31 INTEGER, PUBLIC :: numrtr, numrtw !: logical unit for trc restart (read and write) 35 32 36 37 33 !! * Substitutions 38 34 # include "passivetrc_substitute.h90" 35 !!---------------------------------------------------------------------- 36 !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 37 !! $Id:$ 38 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 39 !!---------------------------------------------------------------------- 39 40 40 41 CONTAINS … … 52 53 !!---------------------------------------------------------------------- 53 54 ! 54 55 55 IF( kt == nit000 ) THEN 56 56 lrst_trc = .FALSE. 57 # if defined key_off_tra57 # if defined key_off_tra 58 58 nitrst = nitend ! in online version, already done in rst_opn routine defined in restart.F90 module 59 # endif59 # endif 60 60 ENDIF 61 61 … … 63 63 ! beware if model runs less than 2*ndttrc time step 64 64 ! beware of the format used to write kt (default is i8.8, that should be large enough) 65 IF( nitrst > 1.0e9 ) THEN 66 WRITE(clkt,*) nitrst 67 ELSE 68 WRITE(clkt,'(i8.8)') nitrst 65 IF( nitrst > 1.0e9 ) THEN ; WRITE(clkt,* ) nitrst 66 ELSE ; WRITE(clkt,'(i8.8)') nitrst 69 67 ENDIF 70 68 ! create the file … … 80 78 81 79 SUBROUTINE trc_rst_read 82 !!=========================================================================================== 80 !!---------------------------------------------------------------------- 81 !! *** trc_rst_opn *** 83 82 !! 84 !! ROUTINE trc_rst_read 85 !! ******************* 86 !! 87 !! PURPOSE : 88 !! --------- 89 !! READ files for restart for passive tracer 90 !! 91 !! METHOD : 92 !! ------- 93 !! READ the previous fields on the FILE nutrst 94 !! the first record indicates previous characterics 95 !! after control with the present run, we READ : 96 !! - prognostic variables on the second and more record 97 !! 98 !! History: 99 !! -------- 100 !! original : 96-11 101 !! 00-05 (A. Estublier) TVD Limiter Scheme key_trc_tvd 102 !! 00-12 (O. Aumont, E. Kestenare) read restart file for sediments 103 !! 01-05 (O. Aumont, E. Kestenare) read restart file for calcite and silicate sediments 104 !! 05-03 (O. Aumont and A. El Moussaoui) F90 105 !!------------------------------------------------------------------------ 106 INTEGER :: ji, jj, jk, jn 107 INTEGER :: iarak0 108 REAL(wp) :: zkt, zarak0 109 REAL(wp) :: caralk, bicarb, co3 110 111 #if defined key_trc_pisces 112 # if ! defined key_cfg_1d && ( defined key_orca_r4 || defined key_orca_r2 || defined key_orca_r05 || defined key_orca_r025 ) 113 REAL(wp) :: ztrasum 114 # endif 115 #endif 116 117 !!--------------------------------------------------------------------- 118 !! OPA.9 03-2005 119 !!--------------------------------------------------------------------- 120 !! 0. initialisations 121 !!------------------ 122 123 124 IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN 125 iarak0 = 1 126 ELSE 127 iarak0 = 0 128 ENDIF 129 130 131 IF(lwp) WRITE(numout,*) ' ' 132 IF(lwp) WRITE(numout,*) ' *** trc_rst beginning of restart for' 133 IF(lwp) WRITE(numout,*) ' passive tracer' 134 IF(lwp) WRITE(numout,*) ' the present run :' 135 IF(lwp) WRITE(numout,*) ' with the time nit000 : ',nit000 136 IF(lwp) THEN 137 IF( iarak0 == 1 ) THEN 138 WRITE(numout,*) ' and before fields for Arakawa sheme ' 139 ENDIF 140 WRITE(numout,*) ' ' 83 !! ** purpose : read passive tracer fields in restart files 84 !!---------------------------------------------------------------------- 85 INTEGER :: ji, jj, jk, jn 86 INTEGER :: iarak0 87 REAL(wp) :: zkt, zarak0 88 REAL(wp) :: caralk, bicarb, co3 89 REAL(wp) :: ztrasum 90 !!---------------------------------------------------------------------- 91 92 IF(lwp) WRITE(numout,*) 93 IF(lwp) WRITE(numout,*) 'trc_rst_read : read restart file of the passive tracers' 94 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 95 96 ztrasum = 0.e0 97 IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN ; iarak0 = 1 98 ELSE ; iarak0 = 0 99 ENDIF 100 101 IF(lwp) WRITE(numout,*) 102 IF(lwp) WRITE(numout,*) ' the present run starts at the time step nit000 = ', nit000 103 IF(lwp .AND. iarak0 == 1 ) WRITE(numout,*) ' and needs previous fields for Arakawa sheme ??? ' 141 104 ENDIF 142 105 143 106 ! Time domain : restart 144 107 ! ------------------------- 145 146 IF(lwp) WRITE(numout,*)147 108 IF(lwp) WRITE(numout,*) 148 109 IF(lwp) WRITE(numout,*) ' *** passive tracer restart option' … … 168 129 IF(lwp) WRITE(numout,*) ' time-step : ', NINT( zkt ) 169 130 IF(lwp) WRITE(numout,*) ' arakawa option : ', NINT( zarak0 ) 170 IF(lwp) WRITE(numout,*) 171 172 173 !! control of date 174 !! ------------------- 175 176 IF( nittrc000 - NINT( zkt ) /= 1 .AND. nrsttr /= 0 ) & 177 & CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart', & 178 & ' verify the restart file or rerun with nrstdt = 0 (namelist)' ) 179 180 !! Control of the scheme 181 !! ------------------------ 182 183 IF( iarak0 /= NINT( zarak0 ) ) & 184 & CALL ctl_stop( ' ===>>>> : problem with advection scheme', & 185 & ' it must be the same type for both restart and previous run', & 186 & ' centered or euler ' ) 187 188 189 !! ... READ prognostic variables and computes diagnostic variable 190 !! --------------------------------------------------------------- 191 131 132 133 IF( nittrc000 - NINT( zkt ) /= 1 .AND. nrsttr /= 0 ) & ! control of date 134 & CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart', & 135 & ' verify the restart file or rerun with nrstdt = 0 (namelist)' ) 136 137 IF( iarak0 /= NINT( zarak0 ) ) & ! Control of the scheme 138 & CALL ctl_stop( ' ===>>>> : problem with advection scheme', & 139 & ' it must be the same type for both restart and previous run', & 140 & ' centered or euler ' ) 141 142 143 ! READ prognostic variables and computes diagnostic variable 192 144 DO jn = 1, jptra 193 CALL iom_get( numrtr, jpdom_local, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) 145 CALL iom_get( numrtr, jpdom_local, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) 146 CALL iom_get( numrtr, jpdom_local, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 194 147 END DO 195 196 DO jn = 1, jptra 197 CALL iom_get( numrtr, jpdom_local, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 198 END DO 199 200 #if defined key_trc_lobster1 148 # if defined key_trc_lobster1 201 149 CALL iom_get( numrtr, jpdom_local, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) ) 202 150 CALL iom_get( numrtr, jpdom_local, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) ) 203 204 #elif defined key_trc_pisces 151 # elif defined key_trc_pisces 205 152 CALL iom_get( numrtr, jpdom_local, 'Silicalim', xksi(:,:) ) 206 153 xksimax = xksi 207 208 #elif defined key_cfc 154 # elif defined key_cfc 209 155 DO jn = 1, jptra 210 CALL iom_get( numrtr, jpdom_local, 'qint'//ctrcnm(jn),qint(:,:,jn)) 156 CALL iom_get( numrtr, jpdom_local, 'qint'//ctrcnm(jn), qint(:,:,jn) ) 157 CALL iom_get( numrtr, jpdom_local, 'qtr'//ctrcnm(jn) , qtr( :,:,jn) ) 211 158 END DO 212 DO jn = 1, jptra 213 CALL iom_get( numrtr, jpdom_local, 'qtr'//ctrcnm(jn) ,qtr( :,:,jn)) 214 END DO 215 #endif 216 217 218 #if defined key_trc_pisces 219 220 #if ! defined key_cfg_1d && ( defined key_orca_r4 || defined key_orca_r2 || defined key_orca_r05 || defined key_orca_r025 ) 221 222 ztrasum = 0. 223 DO jk = 1, jpk 224 DO jj = 1, jpj 225 DO ji = 1, jpi 226 ztrasum = ztrasum + trn(ji,jj,jk,jptal) * tmask(ji,jj,jk) * tmask_i(ji,jj) & 227 #if defined key_off_degrad 228 & * facvol(ji,jj,jk) & 229 #endif 230 231 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 232 END DO 233 END DO 234 END DO 235 236 IF( lk_mpp ) THEN 237 CALL mpp_sum( ztrasum ) ! sum over the global domain 238 END IF 239 240 WRITE(0,*) 'TALK moyen ', ztrasum/areatot*1E6 241 ztrasum = ztrasum/areatot*1E6 242 trn(:,:,:,jptal) = trn(:,:,:,jptal)*2391./ztrasum 243 244 ztrasum = 0. 245 DO jk = 1, jpk 246 DO jj = 1, jpj 247 DO ji = 1, jpi 248 ztrasum = ztrasum + trn(ji,jj,jk,jppo4) * tmask(ji,jj,jk) * tmask_i(ji,jj) & 249 #if defined key_off_degrad 250 & * facvol(ji,jj,jk) & 251 #endif 252 253 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 254 END DO 255 END DO 256 END DO 257 258 IF( lk_mpp ) THEN 259 CALL mpp_sum( ztrasum ) ! sum over the global domain 260 END IF 261 262 263 WRITE(0,*) 'PO4 moyen ', ztrasum/areatot*1E6/122. 264 ztrasum = ztrasum/areatot*1E6/122. 265 trn(:,:,:,jppo4) = trn(:,:,:,jppo4)*2.165/ztrasum 266 267 ztrasum = 0. 268 DO jk = 1, jpk 269 DO jj = 1, jpj 270 DO ji = 1, jpi 271 ztrasum = ztrasum + trn(ji,jj,jk,jpno3) * tmask(ji,jj,jk) * tmask_i(ji,jj) & 272 #if defined key_off_degrad 273 & * facvol(ji,jj,jk) & 274 #endif 275 276 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 277 END DO 278 END DO 279 END DO 280 281 IF( lk_mpp ) THEN 282 CALL mpp_sum( ztrasum ) ! sum over the global domain 283 END IF 284 285 286 WRITE(0,*) 'NO3 moyen ', ztrasum/areatot*1E6/7.6 287 ztrasum = ztrasum/areatot*1E6/7.6 288 trn(:,:,:,jpno3) = trn(:,:,:,jpno3)*30.9/ztrasum 289 290 ztrasum = 0. 291 DO jk = 1, jpk 292 DO jj = 1, jpj 293 DO ji = 1, jpi 294 ztrasum = ztrasum + trn(ji,jj,jk,jpsil) * tmask(ji,jj,jk) * tmask_i(ji,jj) & 295 #if defined key_off_degrad 296 & * facvol(ji,jj,jk) & 297 #endif 298 299 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 300 END DO 301 END DO 302 END DO 303 304 IF( lk_mpp ) THEN 305 CALL mpp_sum( ztrasum ) ! sum over the global domain 306 END IF 307 308 WRITE(0,*) 'SiO3 moyen ', ztrasum/areatot*1E6 309 ztrasum = ztrasum/areatot*1E6 310 trn(:,:,:,jpsil) = MIN( 400E-6,trn(:,:,:,jpsil)*91.51/ztrasum) 311 312 #endif 159 # endif 160 161 # if defined key_trc_pisces 162 ! ! --------------------------- ! 163 IF( cp_cfg == "orca" .AND. .NOT. lk_trccfg_1d ) THEN ! ORCA condiguration (not 1D) ! 164 ! ! --------------------------- ! 165 ! ! set total alkalinity, phosphate, NO3 & silicate 166 ! ! total alkalinity 167 ztrasum = 0.e0 ! ---------------- 168 DO jk = 1, jpk 169 DO jj = 1, jpj 170 DO ji = 1, jpi 171 ztrasum = ztrasum + trn(ji,jj,jk,jptal) * tmask(ji,jj,jk) * tmask_i(ji,jj) & 172 # if defined key_off_degrad 173 & * facvol(ji,jj,jk) & 174 # endif 175 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 176 END DO 177 END DO 178 END DO 179 IF( lk_mpp ) CALL mpp_sum( ztrasum ) ! sum over the global domain 180 181 IF(lwp) WRITE(numout,*) 'TALK moyen ', ztrasum / areatot * 1.e6 182 ztrasum = ztrasum / areatot * 1.e6 183 trn(:,:,:,jptal) = trn(:,:,:,jptal) * 2391. / ztrasum 184 185 ! ! phosphate 186 ztrasum = 0.e0 ! --------- 187 DO jk = 1, jpk 188 DO jj = 1, jpj 189 DO ji = 1, jpi 190 ztrasum = ztrasum + trn(ji,jj,jk,jppo4) * tmask(ji,jj,jk) * tmask_i(ji,jj) & 191 # if defined key_off_degrad 192 & * facvol(ji,jj,jk) & 193 # endif 194 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 195 END DO 196 END DO 197 END DO 198 IF( lk_mpp ) CALL mpp_sum( ztrasum ) ! sum over the global domain 199 200 IF(lwp) WRITE(numout,*) 'PO4 moyen ', ztrasum/areatot*1E6/122. 201 ztrasum = ztrasum / areatot * 1.e6 / 122. 202 trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * 2.165 / ztrasum 203 204 ! ! NO3 205 ztrasum = 0.e0 ! --- 206 DO jk = 1, jpk 207 DO jj = 1, jpj 208 DO ji = 1, jpi 209 ztrasum = ztrasum + trn(ji,jj,jk,jpno3) * tmask(ji,jj,jk) * tmask_i(ji,jj) & 210 # if defined key_off_degrad 211 & * facvol(ji,jj,jk) & 212 # endif 213 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 214 END DO 215 END DO 216 END DO 217 IF( lk_mpp ) CALL mpp_sum( ztrasum ) ! sum over the global domain 218 219 IF(lwp) WRITE(numout,*) 'NO3 moyen ', ztrasum / areatot*1.e6 / 7.6 220 ztrasum = ztrasum / areatot * 1.e6 / 7.6 221 trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * 30.9 / ztrasum 222 223 ! ! Silicate 224 ztrasum = 0.e0 ! -------- 225 DO jk = 1, jpk 226 DO jj = 1, jpj 227 DO ji = 1, jpi 228 ztrasum = ztrasum + trn(ji,jj,jk,jpsil) * tmask(ji,jj,jk) * tmask_i(ji,jj) & 229 # if defined key_off_degrad 230 & * facvol(ji,jj,jk) & 231 # endif 232 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 233 END DO 234 END DO 235 END DO 236 IF( lk_mpp ) CALL mpp_sum( ztrasum ) ! sum over the global domain 237 238 IF(lwp) WRITE(numout,*) 'SiO3 moyen ', ztrasum / areatot * 1.e6 239 ztrasum = ztrasum / areatot * 1.e6 240 trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * 91.51 / ztrasum ) 241 ! 242 ENDIF 313 243 314 244 !#if defined key_trc_kriest … … 319 249 ! trn(:,:,:,jpnum) = trn(:,:,:,jppoc) / ( 6. * xkr_massp ) 320 250 !#endif 321 !! Initialization of chemical variables of the carbon cycle322 !! -------------------------------------------------------- 323 DO jk = 1, jpk324 DO jj = 1, jpj251 !! Set hi (???) from total alcalinity, borat (???), akb3 (???) and ak23 (???) 252 !! --------------------------------------------------------------------- 253 DO jk = 1, jpk 254 DO jj = 1, jpj 325 255 DO ji = 1,jpi 326 caralk = trn(ji,jj,jk,jptal)- & 327 & borat(ji,jj,jk)/(1.+1.E-8/(rtrn+akb3(ji,jj,jk))) 328 co3 = (caralk-trn(ji,jj,jk,jpdic))*tmask(ji,jj,jk) & 329 & +(1.-tmask(ji,jj,jk))*.5e-3 330 bicarb = (2.*trn(ji,jj,jk,jpdic)-caralk) 331 hi(ji,jj,jk) = (ak23(ji,jj,jk)*bicarb/co3) & 332 & *tmask(ji,jj,jk)+(1.-tmask(ji,jj,jk))*1.e-9 333 ENDDO 334 ENDDO 335 ENDDO 336 #endif 256 caralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / ( 1. + 1.e-8 / ( rtrn + akb3(ji,jj,jk) ) ) 257 co3 = ( caralk - trn(ji,jj,jk,jpdic) ) * tmask(ji,jj,jk) & 258 & + 0.5e-3 * ( 1.- tmask(ji,jj,jk) ) 259 bicarb = 2.* trn(ji,jj,jk,jpdic) - caralk 260 hi(ji,jj,jk) = ( ak23(ji,jj,jk) * bicarb / co3 ) * tmask(ji,jj,jk) 261 & + 1.0e-9 * ( 1.- tmask(ji,jj,jk) ) 262 END DO 263 END DO 264 END DO 265 # endif 337 266 trb(:,:,:,:) = trn(:,:,:,:) 338 267 339 268 CALL iom_close( numrtr ) 340 341 269 ! 342 270 END SUBROUTINE trc_rst_read 343 271 344 SUBROUTINE trc_rst_wri(kt) 345 !! ================================================================================== 272 273 SUBROUTINE trc_rst_wri( kt ) 274 !!---------------------------------------------------------------------- 275 !! *** trc_rst_wri *** 346 276 !! 347 !! ROUTINE trc_rst_wri 348 !! ****************** 277 !! ** purpose : write passive tracer fields in restart files 278 !!---------------------------------------------------------------------- 279 INTEGER, INTENT( in ) :: kt 349 280 !! 350 !! PURPOSE :351 !! ---------352 !! WRITE restart fields in nutwrs353 !! METHOD :354 !! -------355 !!356 !! nutwrs FILE:357 !! each nstock time step , SAVE fields which are necessary for358 !! passive tracer restart359 !!360 !!361 !! INPUT :362 !! -----363 !! argument364 !! kt : time step365 !! COMMON366 !! /cottrc/ : passive tracers fields (before,now367 !! ,after)368 !!369 !! OUTPUT :370 !! ------371 !! FILE372 !! nutwrs : standard restart fields OUTPUT373 !!374 !! WORKSPACE :375 !! ---------376 !! ji,jj,jk,jn377 !!378 !! History:379 !! --------380 !! original : 96-12381 !! addition : 99-12 (M.-A. Foujols) NetCDF FORMAT with ioipsl382 !! additions : 00-05 (A. Estublier)383 !! TVD Limiter Scheme : key_trc_tvd384 !! additions : 01-01 (M.A Foujols, E. Kestenare) bug fix: restclo385 !! additions : 01-01 (O. Aumont, E. Kestenare)386 !! write restart file for sediments387 !! additions : 01-05 (O. Aumont, E. Kestenare)388 !! write restart file for calcite and silicate sediments389 !! 05-03 (O. Aumont and A. El Moussaoui) F90390 !!========================================================================================!391 392 !! * Arguments393 !! -----------394 INTEGER, INTENT( in ) :: kt395 396 !! * local declarations397 !! ====================398 399 281 INTEGER :: ji,jj,jk,jn 400 282 REAL(wp) :: zdiag_var, zdiag_varmin, zdiag_varmax, zdiag_tot 401 283 REAL(wp) :: zder 402 403 404 !! 1. OUTPUT of restart fields (nutwrs) 405 !! --------------------------- 406 407 IF( MOD(kt,nstock) == 0 .OR. kt == nitend ) THEN 408 409 !! 0. initialisations 410 !! ------------------ 411 412 IF(lwp) WRITE(numout,*) ' ' 413 IF(lwp) WRITE(numout,*) 'trc_wri : write the passive tracer restart file in NetCDF format ', & 414 'at it= ',kt,' date= ',ndastp 284 !!---------------------------------------------------------------------- 285 286 IF( MOD( kt, nstock ) == 0 .OR. kt == nitend ) THEN 287 288 ! 0. initialisations 289 ! ------------------ 290 IF(lwp) WRITE(numout,*) 291 IF(lwp) WRITE(numout,*) 'trc_wri : write the passive tracer restart file (NetCDF) ', & 292 & 'at it= ',kt,' date= ',ndastp 415 293 IF(lwp) WRITE(numout,*) '~~~~~~~~~' 416 294 … … 427 305 ! prognostic variables 428 306 ! -------------------- 429 430 DO jn=1,jptra 307 DO jn = 1, jptra 431 308 CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) 432 ENDDO433 434 DO jn=1,jptra435 309 CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 436 310 END DO … … 443 317 444 318 #elif defined key_cfc 445 DO jn =1,jptra319 DO jn = 1, jptra 446 320 CALL iom_rstput( kt, nitrst, numrtw, 'qint'//ctrcnm(jn), qint(:,:,jn) ) 447 END DO448 DO jn=1,jptra449 321 CALL iom_rstput( kt, nitrst, numrtw, 'qtr'//ctrcnm(jn) , qtr( :,:,jn) ) 450 322 END DO 451 323 #endif 452 324 453 IF (lwp) WRITE(numout,*) '----TRACER STAT----' 454 455 zdiag_tot=0. 456 DO jn=1,jptra 457 zdiag_var=0. 458 zdiag_varmin=0. 459 zdiag_varmax=0. 460 461 DO ji=1, jpi 462 DO jj=1, jpj 463 DO jk=1,jpk 464 zdiag_var=zdiag_var+trn(ji,jj,jk,jn)*tmask(ji,jj,jk)*tmask_i(ji,jj) & 325 IF(lwp) WRITE(numout,*) '----TRACER STAT----' 326 327 zdiag_tot = 0.e0 328 DO jn = 1, jptra 329 zdiag_var = 0.e0 330 zdiag_varmin = 0.e0 331 zdiag_varmax = 0.e0 332 DO ji = 1, jpi 333 DO jj = 1, jpj 334 DO jk = 1,jpk 335 zdiag_var = zdiag_var + trn(ji,jj,jk,jn) * tmask(ji,jj,jk) * tmask_i(ji,jj) & 465 336 #if defined key_off_degrad 466 337 & * facvol(ji,jj,jk) & 467 338 #endif 468 339 & * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 469 470 340 END DO 471 341 END DO 472 342 END DO 473 343 474 zdiag_varmin =MINVAL(trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)))475 zdiag_varmax =MAXVAL(trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)))344 zdiag_varmin = MINVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 345 zdiag_varmax = MAXVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 476 346 477 347 IF( lk_mpp ) THEN 478 CALL mpp_min( zdiag_varmin) ! min over the global domain479 CALL mpp_max( zdiag_varmax) ! max over the global domain480 CALL mpp_sum( zdiag_var)! sum over the global domain348 CALL mpp_min( zdiag_varmin ) ! min over the global domain 349 CALL mpp_max( zdiag_varmax ) ! max over the global domain 350 CALL mpp_sum( zdiag_var ) ! sum over the global domain 481 351 END IF 482 352 483 zdiag_tot=zdiag_tot+zdiag_var 484 zdiag_var=zdiag_var/areatot 485 486 IF (lwp) WRITE(numout,*) 'MEAN NO ',jn,ctrcnm(jn),' =',zdiag_var,'MIN= ' & 487 ,zdiag_varmin,'MAX= ',zdiag_varmax 488 353 zdiag_tot = zdiag_tot + zdiag_var 354 zdiag_var = zdiag_var / areatot 355 356 IF(lwp) WRITE(numout,*) 'MEAN NO ', jn, ctrcnm(jn), ' =', zdiag_var, & 357 & 'MIN= ', zdiag_varmin, 'MAX= ', zdiag_varmax 489 358 END DO 490 359 … … 495 364 496 365 CALL iom_close(numrtw) 497 498 ENDIF 499 366 ! 367 ENDIF 368 ! 500 369 END SUBROUTINE trc_rst_wri 501 370 502 503 371 #else 504 !! ======================================================================505 !! Empty module :No passive tracer506 !! ======================================================================372 !!---------------------------------------------------------------------- 373 !! Dummy module : No passive tracer 374 !!---------------------------------------------------------------------- 507 375 CONTAINS 508 509 SUBROUTINE trc_rst_read 510 !! no passive tracers 376 SUBROUTINE trc_rst_read ! Empty routines 511 377 END SUBROUTINE trc_rst_read 512 513 SUBROUTINE trc_rst_wri(kt) 514 !! no passive tracers 378 SUBROUTINE trc_rst_wri( kt ) 515 379 INTEGER, INTENT ( in ) :: kt 516 380 WRITE(*,*) 'trc_rst_wri: You should not have seen this print! error?', kt 517 END SUBROUTINE trc_rst_wri 518 381 END SUBROUTINE trc_rst_wri 519 382 #endif 520 383 384 !!====================================================================== 521 385 END MODULE trcrst
Note: See TracChangeset
for help on using the changeset viewer.