Changeset 2007 for branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
- Timestamp:
- 2010-07-13T17:14:39+02:00 (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
r1655 r2007 1 1 MODULE trcrst 2 2 !!====================================================================== 3 !! *** MODULE trcrst ***4 !! TOP : create, write, read the restart files for passive tracers3 !! *** MODULE trcrst *** 4 !! TOP : Manage the passive tracer restart 5 5 !!====================================================================== 6 !! History : 1.0 ! 2007-02 (C. Ethe) adaptation from the ocean 6 !! History : - ! 1991-03 () original code 7 !! 1.0 ! 2005-03 (O. Aumont, A. El Moussaoui) F90 8 !! - ! 2005-10 (C. Ethe) print control 9 !! 2.0 ! 2005-10 (C. Ethe, G. Madec) revised architecture 7 10 !!---------------------------------------------------------------------- 8 11 #if defined key_top 12 !!---------------------------------------------------------------------- 13 !! 'key_top' TOP models 14 !!---------------------------------------------------------------------- 15 !!---------------------------------------------------------------------- 16 !! trc_rst : Restart for passive tracer 17 !!---------------------------------------------------------------------- 9 18 !!---------------------------------------------------------------------- 10 19 !! 'key_top' TOP models … … 16 25 USE oce_trc 17 26 USE trc 18 USE sms_lobster ! LOBSTER variables 19 USE sms_pisces ! PISCES variables 20 USE trcsms_cfc ! CFC variables 21 USE trcsms_c14b ! C14 variables 22 USE trcsms_my_trc ! MY_TRC variables 23 USE trctrp_lec 27 USE trctrp_lec 24 28 USE lib_mpp 25 29 USE iom 26 30 USE trcrst_cfc ! CFC 31 USE trcrst_lobster ! LOBSTER restart 32 USE trcrst_pisces ! PISCES restart 33 USE trcrst_c14b ! C14 bomb restart 34 USE trcrst_my_trc ! MY_TRC restart 35 #if defined key_off_tra 36 USE daymod 37 #endif 27 38 IMPLICIT NONE 28 39 PRIVATE 29 40 30 41 PUBLIC trc_rst_opn ! called by ??? 31 42 PUBLIC trc_rst_read ! called by ??? 32 43 PUBLIC trc_rst_wri ! called by ??? 33 44 34 45 INTEGER, PUBLIC :: numrtr, numrtw !: logical unit for trc restart (read and write) 35 36 46 37 47 !! * Substitutions … … 89 99 END SUBROUTINE trc_rst_opn 90 100 91 92 SUBROUTINE trc_rst_read 101 SUBROUTINE trc_rst_read 93 102 !!---------------------------------------------------------------------- 94 103 !! *** trc_rst_opn *** … … 96 105 !! ** purpose : read passive tracer fields in restart files 97 106 !!---------------------------------------------------------------------- 98 INTEGER :: jn 99 INTEGER :: iarak0 107 INTEGER :: jn 108 INTEGER :: iarak0 100 109 REAL(wp) :: zarak0 101 110 INTEGER :: jlibalt = jprstlib 102 111 LOGICAL :: llok 103 #if defined key_pisces104 INTEGER :: ji, jj, jk105 REAL(wp) :: zcaralk, zbicarb, zco3106 REAL(wp) :: ztmas, ztmas1107 #endif108 112 109 113 !!---------------------------------------------------------------------- … … 115 119 IF ( jprstlib == jprstdimg ) THEN 116 120 ! eventually read netcdf file (monobloc) for restarting on different number of processors 117 ! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90 121 ! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90 118 122 INQUIRE( FILE = TRIM(cn_trcrst_in)//'.nc', EXIST = llok ) 119 IF ( llok ) THEN ; jlibalt = jpnf90 ; ELSE ; jlibalt = jprstlib ; ENDIF 120 ENDIF 121 122 CALL iom_open( cn_trcrst_in, numrtr, kiolib = jlibalt ) 123 IF ( llok ) THEN ; jlibalt = jpnf90 ; ELSE ; jlibalt = jprstlib ; ENDIF 124 ENDIF 125 126 CALL iom_open( cn_trcrst_in, numrtr, kiolib = jlibalt ) 123 127 124 128 ! Time domain : restart … … 136 140 & ' centered or euler ' ) 137 141 IF(lwp) WRITE(numout,*) 138 139 142 IF(lwp) WRITE(numout,*) ' arakawa option : ', NINT( zarak0 ) 140 143 141 142 144 ! READ prognostic variables and computes diagnostic variable 143 145 DO jn = 1, jptra 144 CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) 145 END DO 146 147 DO jn = 1, jptra 148 CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 149 END DO 150 151 #if defined key_lobster 152 CALL iom_get( numrtr, jpdom_autoglo, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) ) 153 CALL iom_get( numrtr, jpdom_autoglo, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) ) 154 #endif 155 #if defined key_pisces 156 ! 157 IF( ln_pisdmp ) CALL pis_dmp_ini ! relaxation of some tracers 158 ! 159 IF( iom_varid( numrtr, 'PH', ldstop = .FALSE. ) > 0 ) THEN 160 CALL iom_get( numrtr, jpdom_autoglo, 'PH' , hi(:,:,:) ) 161 ELSE 162 ! Set PH from total alkalinity, borat (???), akb3 (???) and ak23 (???) 163 ! -------------------------------------------------------- 164 DO jk = 1, jpk 165 DO jj = 1, jpj 166 DO ji = 1, jpi 167 ztmas = tmask(ji,jj,jk) 168 ztmas1 = 1. - tmask(ji,jj,jk) 169 zcaralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / ( 1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) ) ) 170 zco3 = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1 171 zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk ) 172 hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1 173 END DO 174 END DO 175 END DO 176 ENDIF 177 CALL iom_get( numrtr, jpdom_autoglo, 'Silicalim', xksi(:,:) ) 178 IF( iom_varid( numrtr, 'Silicamax', ldstop = .FALSE. ) > 0 ) THEN 179 CALL iom_get( numrtr, jpdom_autoglo, 'Silicamax' , xksimax(:,:) ) 180 ELSE 181 xksimax(:,:) = xksi(:,:) 182 ENDIF 183 #endif 184 #if defined key_cfc 185 DO jn = jp_cfc0, jp_cfc1 186 CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) ) 187 END DO 188 #endif 189 #if defined key_c14b 190 CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn) , qint_c14(:,:) ) 191 #endif 192 #if defined key_my_trc 193 #endif 194 146 CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) 147 END DO 148 149 DO jn = 1, jptra 150 CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 151 END DO 152 153 IF( lk_lobster ) CALL trc_rst_read_lobster( numrtr ) ! LOBSTER bio-model 154 IF( lk_pisces ) CALL trc_rst_read_pisces ( numrtr ) ! PISCES bio-model 155 IF( lk_cfc ) CALL trc_rst_read_cfc ( numrtr ) ! CFC tracers 156 IF( lk_c14b ) CALL trc_rst_read_c14b ( numrtr ) ! C14 bomb tracer 157 IF( lk_my_trc ) CALL trc_rst_read_my_trc ( numrtr ) ! MY_TRC tracers 158 195 159 CALL iom_close( numrtr ) 196 160 ! 197 161 END SUBROUTINE trc_rst_read 198 199 162 200 163 SUBROUTINE trc_rst_wri( kt ) … … 218 181 CALL iom_rstput( kt, nitrst, numrtw, 'arak0', zarak0 ) 219 182 220 ! prognostic variables 221 ! -------------------- 183 ! prognostic variables 184 ! -------------------- 222 185 DO jn = 1, jptra 223 186 CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) … … 228 191 END DO 229 192 230 #if defined key_lobster 231 CALL iom_rstput( kt, nitrst, numrtw, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) ) 232 CALL iom_rstput( kt, nitrst, numrtw, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) ) 233 #endif 234 #if defined key_pisces 235 CALL iom_rstput( kt, nitrst, numrtw, 'PH', hi(:,:,:) ) 236 CALL iom_rstput( kt, nitrst, numrtw, 'Silicalim', xksi(:,:) ) 237 CALL iom_rstput( kt, nitrst, numrtw, 'Silicamax', xksimax(:,:) ) 238 #endif 239 #if defined key_cfc 240 DO jn = jp_cfc0, jp_cfc1 241 CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) ) 242 END DO 243 #endif 244 #if defined key_c14b 245 CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_c14(:,:) ) 246 #endif 247 #if defined key_my_trc 248 #endif 249 193 IF( lk_lobster ) CALL trc_rst_wri_lobster( kt, nitrst, numrtw ) ! LOBSTER bio-model 194 IF( lk_pisces ) CALL trc_rst_wri_pisces ( kt, nitrst, numrtw ) ! PISCES bio-model 195 IF( lk_cfc ) CALL trc_rst_wri_cfc ( kt, nitrst, numrtw ) ! CFC tracers 196 IF( lk_c14b ) CALL trc_rst_wri_c14b ( kt, nitrst, numrtw ) ! C14 bomb tracer 197 IF( lk_my_trc ) CALL trc_rst_wri_my_trc ( kt, nitrst, numrtw ) ! MY_TRC tracers 198 250 199 IF( kt == nitrst ) THEN 251 200 CALL trc_rst_stat ! statistics … … 256 205 ENDIF 257 206 ! 258 END SUBROUTINE trc_rst_wri 207 END SUBROUTINE trc_rst_wri 208 259 209 260 210 SUBROUTINE trc_rst_cal( kt, cdrw ) … … 329 279 WRITE(numout,*) 330 280 ENDIF 281 ! 282 CALL day_init ! compute calendar 283 ! 331 284 #endif 332 285 … … 347 300 END SUBROUTINE trc_rst_cal 348 301 349 # if defined key_pisces350 351 SUBROUTINE pis_dmp_ini352 !!----------------------------------------------------------------------353 !! *** pis_dmp_ini ***354 !!355 !! ** purpose : Relaxation of some tracers356 !!----------------------------------------------------------------------357 INTEGER :: ji, jj, jk358 REAL(wp) :: &359 alkmean = 2426. , & ! mean value of alkalinity ( Glodap ; for Goyet 2391. )360 po4mean = 2.165 , & ! mean value of phosphates361 no3mean = 30.90 , & ! mean value of nitrate362 siomean = 91.51 ! mean value of silicate363 364 REAL(wp) :: zvol, ztrasum365 366 367 IF(lwp) WRITE(numout,*)368 369 IF( cp_cfg == "orca" .AND. .NOT. lk_trc_c1d ) THEN ! ORCA condiguration (not 1D) !370 ! ! --------------------------- !371 ! set total alkalinity, phosphate, NO3 & silicate372 373 ! total alkalinity374 ztrasum = 0.e0375 DO jk = 1, jpk376 DO jj = 1, jpj377 DO ji = 1, jpi378 zvol = cvol(ji,jj,jk)379 # if defined key_off_degrad380 zvol = zvol * facvol(ji,jj,jk)381 # endif382 ztrasum = ztrasum + trn(ji,jj,jk,jptal) * zvol383 END DO384 END DO385 END DO386 IF( lk_mpp ) CALL mpp_sum( ztrasum ) ! sum over the global domain387 388 ztrasum = ztrasum / areatot * 1.e6389 IF(lwp) WRITE(numout,*) ' TALK mean : ', ztrasum390 trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / ztrasum391 392 ! phosphate393 ztrasum = 0.e0394 DO jk = 1, jpk395 DO jj = 1, jpj396 DO ji = 1, jpi397 zvol = cvol(ji,jj,jk)398 # if defined key_off_degrad399 zvol = zvol * facvol(ji,jj,jk)400 # endif401 ztrasum = ztrasum + trn(ji,jj,jk,jppo4) * zvol402 END DO403 END DO404 END DO405 IF( lk_mpp ) CALL mpp_sum( ztrasum ) ! sum over the global domain406 407 ztrasum = ztrasum / areatot * 1.e6 / 122.408 IF(lwp) WRITE(numout,*) ' PO4 mean : ', ztrasum409 trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / ztrasum410 411 ! Nitrates412 ztrasum = 0.e0413 DO jk = 1, jpk414 DO jj = 1, jpj415 DO ji = 1, jpi416 zvol = cvol(ji,jj,jk)417 # if defined key_off_degrad418 zvol = zvol * facvol(ji,jj,jk)419 # endif420 ztrasum = ztrasum + trn(ji,jj,jk,jpno3) * zvol421 END DO422 END DO423 END DO424 IF( lk_mpp ) CALL mpp_sum( ztrasum ) ! sum over the global domain425 426 ztrasum = ztrasum / areatot * 1.e6 / 7.6427 IF(lwp) WRITE(numout,*) ' NO3 mean : ', ztrasum428 trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / ztrasum429 430 ! Silicate431 ztrasum = 0.e0432 DO jk = 1, jpk433 DO jj = 1, jpj434 DO ji = 1, jpi435 zvol = cvol(ji,jj,jk)436 # if defined key_off_degrad437 zvol = zvol * facvol(ji,jj,jk)438 # endif439 ztrasum = ztrasum + trn(ji,jj,jk,jpsil) * zvol440 END DO441 END DO442 END DO443 IF( lk_mpp ) CALL mpp_sum( ztrasum ) ! sum over the global domain444 ztrasum = ztrasum / areatot * 1.e6445 IF(lwp) WRITE(numout,*) ' SiO3 mean : ', ztrasum446 trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * siomean / ztrasum )447 !448 ENDIF449 450 !#if defined key_kriest451 ! !! Initialize number of particles from a standart restart file452 ! !! The name of big organic particles jpgoc has been only change453 ! !! and replace by jpnum but the values here are concentration454 ! trn(:,:,:,jppoc) = trn(:,:,:,jppoc) + trn(:,:,:,jpnum)455 ! trn(:,:,:,jpnum) = trn(:,:,:,jppoc) / ( 6. * xkr_massp )456 !#endif457 458 END SUBROUTINE pis_dmp_ini459 460 #endif461 !!----------------------------------------------------------------------462 302 463 303 SUBROUTINE trc_rst_stat
Note: See TracChangeset
for help on using the changeset viewer.