New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 494 for trunk/NEMO/TOP_SRC/trcrst.F90 – NEMO

Ignore:
Timestamp:
2006-09-01T16:03:49+02:00 (18 years ago)
Author:
opalod
Message:

nemo_v1_update_062:CE+RB: use IOM for passive tracers

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMO/TOP_SRC/trcrst.F90

    r433 r494  
    7171      !!------------------------------------------------------------------------ 
    7272      !! * Modules used 
    73       USE ioipsl 
     73      USE iom 
    7474 
    7575 
    7676      !! local declarations 
    7777      !! ================== 
    78       LOGICAL ::  llog       !!! 
    79       CHARACTER (len=32) :: clname1,clname2 
    80       CHARACTER (len=32) :: clname = 'restart.trc' 
    81       CHARACTER (len=12) :: clvnames(80)   
    82  
    83       INTEGER :: ino1,jn,iarak0,iarak1,          & 
    84          ji, jj, jk,                   & 
    85          itime, ibvar 
    86       REAL(wp) :: caralk,bicarb,zdt,        &      
    87          zdate0 
    88       REAL(wp) ::   zdept(jpk), zlamt(jpi,jpj), zphit(jpi,jpj) 
    89  
    90       REAL(wp), DIMENSION(3) :: zinfo 
     78 
     79      INTEGER :: & 
     80         ji, jj, jk, jn   
     81      INTEGER  ::   & 
     82         inum, iarak0                 ! temporary logical unit 
     83      REAL(wp), DIMENSION(1, 1, 3)  ::   zinfo 
     84 
     85      CHARACTER (len=32) :: clname1,clname2,clname 
     86      REAL(wp) :: caralk,bicarb 
    9187 
    9288#if defined key_trc_pisces  
    93 #if ! defined key_cfg_1d && ( defined key_orca_r4 || defined key_orca_r2 || defined key_orca_r05 || defined key_orca_r025 ) 
    94       REAL(wp) ::   zareatot, zpo4tot 
    95 #endif 
     89#   if ! defined key_cfg_1d && ( defined key_orca_r4 || defined key_orca_r2 || defined key_orca_r05 || defined key_orca_r025 ) 
     90      REAL(wp) ::   zareatot, ztrasum 
     91#   endif 
    9692#endif 
    9793 
    … …  
    106102         iarak0 = 1 
    107103      ELSE 
    108          iarak0=0 
     104         iarak0 = 0 
    109105      ENDIF 
    110106 
    … …  
    117113      IF(lwp) WRITE(numout,*) '   with the time nit000 : ',nit000 
    118114      IF(lwp) THEN 
    119          IF(iarak0.eq.1) then 
     115         IF( iarak0 == 1 ) THEN 
    120116            WRITE(numout,*) '   and before fields for Arakawa sheme ' 
    121117         ENDIF 
    … …  
    142138 
    143139 
    144       !! 1. READ nutrst 
    145       !! -------------- 
    146       !! ... first information 
    147       !! --------------------- 
    148       itime=0 
    149       llog=.false.           !!! 
    150       zlamt(:,:) = 0.e0 
    151       zphit(:,:) = 0.e0 
    152       zdept(:)   = 0.e0 
    153       CALL restini(clname,jpi,jpj,zlamt,zphit,jpk,zdept,clname         &  
    154          &           ,itime,zdate0,zdt,nutrst,domain_id=nidom) 
    155  
    156       CALL ioget_vname(nutrst, ibvar, clvnames) 
    157       CALL restget(nutrst,'info',1,1,3,0,llog,zinfo) 
    158       ino1  = nint(zinfo(1)) 
    159       iarak1 = nint(zinfo(3)) 
    160  
    161       IF(lwp) WRITE(numout,*) ' ' 
    162       IF(lwp) WRITE(numout,*) ' READ nutrst with ' 
    163       IF(lwp) WRITE(numout,*) '   number job is  : ',ino1 
    164       IF(lwp) WRITE(numout,*) '   with the time it : ',nint(zinfo(2)) 
    165       IF(lwp) THEN 
    166          IF(iarak1.eq.1) then 
    167             WRITE(numout,*) '   and before fields for Arakawa sheme ' 
    168          ENDIF 
    169       ENDIF 
    170       IF(lwp) WRITE(numout,*) '   number of variables   : ', ibvar 
    171       IF(lwp) WRITE(numout,*) '   NetCDF variables      : ' 
    172       IF(lwp) WRITE(numout,*) ' ',clvnames (:ibvar) 
    173       IF(lwp) WRITE(numout,*) ' ' 
    174  
    175       !! 1.2 control of date 
     140 
     141      CALL iom_open ( 'restart.trc', inum ) 
     142 
     143      CALL iom_get ( inum, jpdom_unknown, 'info', zinfo ) 
     144 
     145      IF(lwp) WRITE(numout,*) 
     146      IF(lwp) WRITE(numout,*) ' Info on the restart file read : ' 
     147      IF(lwp) WRITE(numout,*) '   job number          : ', NINT( zinfo(1, 1, 1) ) 
     148      IF(lwp) WRITE(numout,*) '   time-step           : ', NINT( zinfo(1, 1, 2) ) 
     149      IF(lwp) WRITE(numout,*) '   arakawa option      : ', NINT( zinfo(1, 1, 3) ) 
     150      IF(lwp) WRITE(numout,*) 
     151 
     152 
     153      !! control of date 
    176154      !! ------------------- 
    177155 
    178       IF( nit000- NINT( zinfo(2) ) /= 1 .AND. nrsttr /= 0 ) THEN 
    179          IF(lwp) THEN 
    180             WRITE(numout,*) ' ===>>>> : problem with nit000 for the',    &   
    181                ' passive tracer restart' 
    182             WRITE(numout,*) ' =======                              ',    &     
    183                ' ======================' 
    184             WRITE(numout,*) ' we stop. verify the FILE' 
    185             WRITE(numout,*) ' or rerun with the value  0 for the' 
    186             WRITE(numout,*) ' control of time PARAMETER   nrstdt' 
    187             WRITE(numout,*) ' ' 
    188          ENDIF 
    189          STOP 'trc_rst'       !! 
    190       ENDIF 
    191  
    192       !! 1.3 Control of the sheme 
     156      IF( nittrc000 - NINT( zinfo( 1, 1, 2 ) ) /= 1 .AND. nrsttr /= 0 )  & 
     157           & CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart', & 
     158           & ' verify the restart file or rerun with nrstdt = 0 (namelist)' ) 
     159 
     160      !! Control of the scheme 
    193161      !! ------------------------ 
    194162 
    195       IF(iarak0.ne.iarak1) THEN 
    196          IF(lwp) THEN 
    197             WRITE(numout,*) ' ===>>>> : problem with the',       &    
    198                ' passive tracer restart file' 
    199             WRITE(numout,*) ' =======                              ',        &  
    200                ' ===========================' 
    201             WRITE(numout,*) ' we stop. verify the FILE' 
    202             WRITE(numout,*) ' before field required IF 1=',iarak0 
    203             WRITE(numout,*) ' before field present in file IF 1=',           &  
    204                iarak1 
    205             WRITE(numout,*) ' ' 
    206          ENDIF 
    207          STOP 'trc_rst'       !!!!!    AVERIFIER AU NIV F90' 
    208       ENDIF 
     163      IF( iarak0 /= NINT( zinfo(1, 1, 3 ) ) ) & 
     164           & CALL ctl_stop( ' ===>>>> : problem with advection scheme', & 
     165           & ' it must be the same type for both restart and previous run', & 
     166           & ' centered or euler '  ) 
    209167 
    210168 
    … …  
    212170      !! --------------------------------------------------------------- 
    213171 
    214       DO jn=1,jptra 
    215          clname='TRN'//ctrcnm(jn) 
    216          CALL restget(nutrst,clname,jpi,jpj,jpk,0,llog,trn(:,:,:,jn)) 
     172      DO jn = 1, jptra 
     173         clname = 'TRN'//ctrcnm(jn) 
     174         CALL iom_get( inum, jpdom_local, clname, trn(:,:,:,jn)   )  
    217175      END DO 
    218176 
    219       DO jn=1,jptra 
    220          clname='TRB'//ctrcnm(jn) 
    221          CALL restget(nutrst,clname,jpi,jpj,jpk,0,llog,trb(:,:,:,jn)) 
     177      DO jn = 1, jptra 
     178         clname = 'TRB'//ctrcnm(jn) 
     179         CALL iom_get( inum, jpdom_local, clname, trb(:,:,:,jn)   )  
    222180      END DO 
    223181 
    224  
    225182#if defined key_trc_lobster1 
    226       clname='SEDB'//ctrcnm(jpdet) 
    227       clname1='SEDN'//ctrcnm(jpdet) 
    228       CALL restget(nutrst,clname,jpi,jpj,1,0,llog,sedpocb(:,:)) 
    229       CALL restget(nutrst,clname1,jpi,jpj,1,0,llog,sedpocn(:,:)) 
     183      clname  = 'SEDB'//ctrcnm(jpdet) 
     184      clname1 = 'SEDN'//ctrcnm(jpdet) 
     185      CALL iom_get( inum, jpdom_local, clname , sedpocb(:,:) )  
     186      CALL iom_get( inum, jpdom_local, clname1, sedpocn(:,:) )  
     187 
    230188#elif defined key_trc_pisces 
    231       clname='Silicalim' 
    232       CALL restget(nutrst,clname,jpi,jpj,1,0,llog,xksi) 
    233       xksimax=xksi 
    234  
    235       clname='SED'//ctrcnm(jppoc) 
    236       clname1='SED'//ctrcnm(jpcal) 
    237       clname2='SED'//ctrcnm(jpsil) 
    238       CALL restget(nutrst,clname1,jpi,jpj,1,0,llog,sedcal(:,:)) 
    239       CALL restget(nutrst,clname2,jpi,jpj,1,0,llog,sedsil(:,:)) 
    240       CALL restget(nutrst,clname,jpi,jpj,1,0,llog,sedpoc(:,:)) 
     189      clname = 'Silicalim' 
     190      CALL iom_get( inum, jpdom_local, clname, xksi(:,:) )  
     191      xksimax = xksi 
     192 
     193      clname  = 'SED'//ctrcnm(jppoc) 
     194      clname1 = 'SED'//ctrcnm(jpcal) 
     195      clname2 = 'SED'//ctrcnm(jpsil) 
     196 
     197      CALL iom_get( inum, jpdom_local, clname , sedpoc(:,:) )  
     198      CALL iom_get( inum, jpdom_local, clname1, sedcal(:,:) )  
     199      CALL iom_get( inum, jpdom_local, clname2, sedsil(:,:) )  
    241200 
    242201#elif defined key_cfc 
    243       clname='qint' 
    244       CALL restget(nutrst,clname,jpi,jpj,jptra,0,llog,qint(:,:,:)) 
    245       clname1='qtr' 
    246       CALL restget(nutrst,clname1,jpi,jpj,jptra,0,llog,qtr(:,:,:))          
     202      clname  = 'qint' 
     203      clname1 = 'qtr' 
     204 
     205      CALL iom_get( inum, jpdom_local, clname , qint(:,:,:) )  
     206      CALL iom_get( inum, jpdom_local, clname1, qtr (:,:,:) )         
    247207#endif 
    248208 
    … …  
    255215         DO jj = 1, jpj 
    256216            DO ji = 1, jpi 
    257                zareatot = zareatot + tmask(ji,jj,jk) * tmask_i(ji,jj) * & 
    258                   &                 e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)  
     217               zareatot = zareatot + tmask(ji,jj,jk) * tmask_i(ji,jj)  & 
     218#if defined key_off_degrad 
     219                  &                * facvol(ji,jj,jk)    & 
     220#endif 
     221 
     222                  &                * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)  
    259223            END DO 
    260224         END DO 
    … …  
    265229      END IF 
    266230 
    267       zpo4tot = 0. 
     231      ztrasum = 0. 
    268232      DO jk = 1, jpk 
    269233         DO jj = 1, jpj 
    270234            DO ji = 1, jpi 
    271                zpo4tot = zpo4tot + trn(ji,jj,jk,jptal) * tmask(ji,jj,jk) * tmask_i(ji,jj) *   & 
    272                   &                e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
     235               ztrasum = ztrasum + trn(ji,jj,jk,jptal) * tmask(ji,jj,jk) * tmask_i(ji,jj)    & 
     236#if defined key_off_degrad 
     237                  &              * facvol(ji,jj,jk)   & 
     238#endif 
     239 
     240                  &              * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
    273241            END DO 
    274242         END DO 
    … …  
    276244 
    277245      IF( lk_mpp ) THEN  
    278          CALL mpp_sum( zpo4tot )     ! sum over the global domain   
     246         CALL mpp_sum( ztrasum )     ! sum over the global domain   
    279247      END IF 
    280248 
    281       WRITE(0,*) 'TALK moyen ', zpo4tot/zareatot*1E6 
    282       zpo4tot = zpo4tot/zareatot*1E6 
    283       trn(:,:,:,jptal) = trn(:,:,:,jptal)*2391./zpo4tot 
    284  
    285       zpo4tot = 0. 
     249      WRITE(0,*) 'TALK moyen ', ztrasum/zareatot*1E6 
     250      ztrasum = ztrasum/zareatot*1E6 
     251      trn(:,:,:,jptal) = trn(:,:,:,jptal)*2391./ztrasum 
     252 
     253      ztrasum = 0. 
    286254      DO jk = 1, jpk 
    287255         DO jj = 1, jpj 
    288256            DO ji = 1, jpi 
    289                zpo4tot = zpo4tot + trn(ji,jj,jk,jppo4) * tmask(ji,jj,jk) * tmask_i(ji,jj) *   & 
    290                   &                e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
     257               ztrasum = ztrasum + trn(ji,jj,jk,jppo4) * tmask(ji,jj,jk) * tmask_i(ji,jj)  & 
     258#if defined key_off_degrad 
     259                  &              * facvol(ji,jj,jk)   & 
     260#endif 
     261 
     262                  &              * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
    291263            END DO 
    292264         END DO 
    … …  
    294266 
    295267      IF( lk_mpp ) THEN  
    296          CALL mpp_sum( zpo4tot )     ! sum over the global domain   
     268         CALL mpp_sum( ztrasum )     ! sum over the global domain   
    297269      END IF 
    298270 
    299271 
    300       WRITE(0,*) 'PO4 moyen ', zpo4tot/zareatot*1E6/122. 
    301       zpo4tot = zpo4tot/zareatot*1E6/122. 
    302       trn(:,:,:,jppo4) = trn(:,:,:,jppo4)*2.165/zpo4tot 
    303  
    304       zpo4tot = 0. 
     272      WRITE(0,*) 'PO4 moyen ', ztrasum/zareatot*1E6/122. 
     273      ztrasum = ztrasum/zareatot*1E6/122. 
     274      trn(:,:,:,jppo4) = trn(:,:,:,jppo4)*2.165/ztrasum 
     275 
     276      ztrasum = 0. 
    305277      DO jk = 1, jpk 
    306278         DO jj = 1, jpj 
    307279            DO ji = 1, jpi 
    308                zpo4tot = zpo4tot + trn(ji,jj,jk,jpno3) * tmask(ji,jj,jk) * tmask_i(ji,jj) *   & 
    309                   &                e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
     280               ztrasum = ztrasum + trn(ji,jj,jk,jpno3) * tmask(ji,jj,jk) * tmask_i(ji,jj)  & 
     281#if defined key_off_degrad 
     282                  &              * facvol(ji,jj,jk)   & 
     283#endif 
     284 
     285                  &              * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
    310286            END DO 
    311287         END DO 
    … …  
    313289 
    314290      IF( lk_mpp ) THEN  
    315          CALL mpp_sum( zpo4tot )     ! sum over the global domain   
     291         CALL mpp_sum( ztrasum )     ! sum over the global domain   
    316292      END IF 
    317293 
    318294 
    319       WRITE(0,*) 'NO3 moyen ', zpo4tot/zareatot*1E6/7.6 
    320       zpo4tot = zpo4tot/zareatot*1E6/7.6 
    321       trn(:,:,:,jpno3) = trn(:,:,:,jpno3)*30.9/zpo4tot 
    322  
    323       zpo4tot = 0. 
     295      WRITE(0,*) 'NO3 moyen ', ztrasum/zareatot*1E6/7.6 
     296      ztrasum = ztrasum/zareatot*1E6/7.6 
     297      trn(:,:,:,jpno3) = trn(:,:,:,jpno3)*30.9/ztrasum 
     298 
     299      ztrasum = 0. 
    324300      DO jk = 1, jpk 
    325301         DO jj = 1, jpj 
    326302            DO ji = 1, jpi 
    327                zpo4tot = zpo4tot + trn(ji,jj,jk,jpsil) * tmask(ji,jj,jk) * tmask_i(ji,jj) *   & 
    328                   &                e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
     303               ztrasum = ztrasum + trn(ji,jj,jk,jpsil) * tmask(ji,jj,jk) * tmask_i(ji,jj)   & 
     304#if defined key_off_degrad 
     305                  &              * facvol(ji,jj,jk)   & 
     306#endif 
     307 
     308                  &              * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
    329309            END DO 
    330310         END DO 
    … …  
    332312 
    333313      IF( lk_mpp ) THEN  
    334          CALL mpp_sum( zpo4tot )     ! sum over the global domain   
     314         CALL mpp_sum( ztrasum )     ! sum over the global domain   
    335315      END IF 
    336316 
    337       WRITE(0,*) 'SiO3 moyen ', zpo4tot/zareatot*1E6 
    338       zpo4tot = zpo4tot/zareatot*1E6 
    339       trn(:,:,:,jpsil) = MIN( 400E-6,trn(:,:,:,jpsil)*91.51/zpo4tot)  
     317      WRITE(0,*) 'SiO3 moyen ', ztrasum/zareatot*1E6 
     318      ztrasum = ztrasum/zareatot*1E6 
     319      trn(:,:,:,jpsil) = MIN( 400E-6,trn(:,:,:,jpsil)*91.51/ztrasum)  
    340320 
    341321#endif 
    … …  
    357337      ENDDO 
    358338#endif 
     339      trb(:,:,:,:) = trn(:,:,:,:) 
     340 
     341      CALL iom_close( inum ) 
     342 
    359343 
    360344   END SUBROUTINE trc_rst 
    … …  
    432416      !! --------------------------- 
    433417 
    434       IF( kt == nit000 ) THEN 
     418      IF( kt == nittrc000 ) THEN 
    435419         IF(lwp) WRITE(numout,*) 
    436420         IF(lwp) WRITE(numout,*) 'trc_wri : write passive tracers restart.output NetCDF file' 
    … …  
    518502         itime=0 
    519503         CALL ymds2ju(nyear,nmonth,nday,0.0,zdate0) 
    520          CALL restini('NONE',jpi,jpj,glamt,gphit,jpk,gdept,clname           & 
     504         CALL restini('NONE',jpi,jpj,glamt,gphit,jpk,gdept_0,clname           & 
    521505            &        ,itime,zdate0,rdt*nstock,nutwrs,domain_id=nidom) 
    522506 
Note: See TracChangeset for help on using the changeset viewer.