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 1077 for trunk/NEMO/TOP_SRC/trcrst.F90 – NEMO

Ignore:
Timestamp:
2008-06-05T14:21:08+02:00 (16 years ago)
Author:
cetlod
Message:

update modules, see ticket:190

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMO/TOP_SRC/trcrst.F90

    r1011 r1077  
    1616   USE oce_trc 
    1717   USE trc 
    18    USE sms 
     18   USE sms_lobster         ! LOBSTER variables 
     19   USE sms_pisces          ! PISCES variables 
    1920   USE trcsms_cfc          ! CFC variables 
    2021   USE trctrp_lec    
     
    131132      END SELECT 
    132133 
    133       CALL iom_open( 'restart.trc', numrtr, kiolib = jprstlib ) 
     134      CALL iom_open( 'restart_trc', numrtr, kiolib = jprstlib ) 
    134135 
    135136      CALL iom_get( numrtr, 'kt'   , zkt    ) 
     
    154155      ! READ prognostic variables and computes diagnostic variable 
    155156      DO jn = 1, jptra 
    156          CALL iom_get( numrtr, jpdom_local, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) )  
    157          CALL iom_get( numrtr, jpdom_local, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )  
     157         CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) )  
    158158      END DO 
    159 # if defined key_lobster 
    160       CALL iom_get( numrtr, jpdom_local, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) )  
    161       CALL iom_get( numrtr, jpdom_local, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) )  
    162 #endif 
     159 
     160     DO jn = 1, jptra 
     161         CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )  
     162      END DO 
     163 
     164#if defined key_lobster 
     165      CALL iom_get( numrtr, jpdom_autoglo, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) )  
     166      CALL iom_get( numrtr, jpdom_autoglo, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) )  
     167#endif 
     168 
    163169#if defined key_pisces 
    164       CALL iom_get( numrtr, jpdom_local, 'Silicalim', xksi(:,:) )  
    165       CALL iom_get( numrtr, jpdom_local, 'Silicamax', xksimax(:,:) ) 
    166 #endif 
     170      CALL iom_get( numrtr, jpdom_autoglo, 'Silicalim', xksi(:,:) )  
     171      CALL iom_get( numrtr, jpdom_autoglo, 'Silicamax', xksimax(:,:) ) 
     172#endif 
     173 
    167174#if defined key_cfc 
    168175      DO jn = jp_cfc0, jp_cfc1 
    169          CALL iom_get( numrtr, jpdom_local, 'qint'//ctrcnm(jn), qint(:,:,jn) )  
    170          CALL iom_get( numrtr, jpdom_local, 'qtr'//ctrcnm(jn) , qtr( :,:,jn) )  
     176         CALL iom_get( numrtr, jpdom_autoglo, 'qint'//ctrcnm(jn), qint(:,:,jn) )  
     177         CALL iom_get( numrtr, jpdom_autoglo, 'qtr'//ctrcnm(jn) , qtr( :,:,jn) )  
    171178      END DO 
    172 # endif 
    173  
    174 # if defined key_pisces  
    175       !                                                         ! --------------------------- ! 
    176       IF( cp_cfg == "orca" .AND. .NOT. lk_trc_c1d ) THEN      ! ORCA condiguration (not 1D) ! 
    177          !                                                      ! --------------------------- ! 
    178          ! set total alkalinity, phosphate, NO3 & silicate 
    179          ! total alkalinity 
    180          ! ----------------------------------------------- 
    181          ztrasum = 0.e0              
    182          DO jk = 1, jpk 
    183             DO jj = 1, jpj 
    184                DO ji = 1, jpi 
    185                   ztrasum = ztrasum + trn(ji,jj,jk,jptal) * tmask(ji,jj,jk) * tmask_i(ji,jj)  & 
     179#endif 
     180 
     181#if defined key_pisces  
     182         !                                                         ! --------------------------- ! 
     183         IF( cp_cfg == "orca" .AND. .NOT. lk_trc_c1d ) THEN      ! ORCA condiguration (not 1D) ! 
     184            !                                                      ! --------------------------- ! 
     185            ! set total alkalinity, phosphate, NO3 & silicate 
     186            ! total alkalinity 
     187            ! ----------------------------------------------- 
     188            ztrasum = 0.e0              
     189            DO jk = 1, jpk 
     190               DO jj = 1, jpj 
     191                  DO ji = 1, jpi 
     192                     ztrasum = ztrasum + trn(ji,jj,jk,jptal) * tmask(ji,jj,jk) * tmask_i(ji,jj)  & 
     193#  if defined key_off_degrad 
     194                        &              * facvol(ji,jj,jk)   & 
     195#  endif 
     196                        &              * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
     197                  END DO 
     198               END DO 
     199            END DO 
     200            IF( lk_mpp )   CALL mpp_sum( ztrasum )     ! sum over the global domain   
     201 
     202 
     203            ztrasum = ztrasum / areatot * 1.e6 
     204            IF(lwp) WRITE(numout,*) 'TALK moyen ', ztrasum 
     205            trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / ztrasum 
     206             
     207            ! phosphate 
     208            ! --------- 
     209            ztrasum = 0.e0 
     210            DO jk = 1, jpk 
     211               DO jj = 1, jpj 
     212                  DO ji = 1, jpi 
     213                     ztrasum = ztrasum + trn(ji,jj,jk,jppo4) * tmask(ji,jj,jk) * tmask_i(ji,jj)  & 
    186214#  if defined key_off_degrad 
    187215                     &              * facvol(ji,jj,jk)   & 
    188216#  endif 
    189217                     &              * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
    190                END DO 
    191             END DO 
    192          END DO 
    193          IF( lk_mpp )   CALL mpp_sum( ztrasum )     ! sum over the global domain   
    194  
    195  
    196          ztrasum = ztrasum / areatot * 1.e6 
    197          IF(lwp) WRITE(numout,*) 'TALK moyen ', ztrasum 
    198          trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / ztrasum 
    199  
    200          ! phosphate 
    201          ! --------- 
    202          ztrasum = 0.e0 
    203          DO jk = 1, jpk 
    204             DO jj = 1, jpj 
    205                DO ji = 1, jpi 
    206                   ztrasum = ztrasum + trn(ji,jj,jk,jppo4) * tmask(ji,jj,jk) * tmask_i(ji,jj)  & 
     218                  END DO 
     219               END DO 
     220            END DO 
     221            IF( lk_mpp )   CALL mpp_sum( ztrasum )     ! sum over the global domain   
     222             
     223            ztrasum = ztrasum / areatot * 1.e6 / 122. 
     224            IF(lwp) WRITE(numout,*) 'PO4 moyen ', ztrasum  
     225            trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / ztrasum 
     226             
     227            ! NO3 
     228            ! --- 
     229            ztrasum = 0.e0 
     230            DO jk = 1, jpk 
     231               DO jj = 1, jpj 
     232                  DO ji = 1, jpi 
     233                     ztrasum = ztrasum + trn(ji,jj,jk,jpno3) * tmask(ji,jj,jk) * tmask_i(ji,jj)  & 
    207234#  if defined key_off_degrad 
    208235                     &              * facvol(ji,jj,jk)   & 
    209236#  endif 
    210237                     &              * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
    211                END DO 
    212             END DO 
    213          END DO 
    214          IF( lk_mpp )   CALL mpp_sum( ztrasum )     ! sum over the global domain   
    215  
    216          ztrasum = ztrasum / areatot * 1.e6 / 122. 
    217          IF(lwp) WRITE(numout,*) 'PO4 moyen ', ztrasum  
    218          trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / ztrasum 
    219  
    220          ! NO3 
    221          ! --- 
    222          ztrasum = 0.e0 
    223          DO jk = 1, jpk 
    224             DO jj = 1, jpj 
    225                DO ji = 1, jpi 
    226                   ztrasum = ztrasum + trn(ji,jj,jk,jpno3) * tmask(ji,jj,jk) * tmask_i(ji,jj)  & 
     238                  END DO 
     239               END DO 
     240            END DO 
     241            IF( lk_mpp )   CALL mpp_sum( ztrasum )     ! sum over the global domain   
     242             
     243            ztrasum = ztrasum / areatot * 1.e6 / 7.6 
     244            IF(lwp) WRITE(numout,*) 'NO3 moyen ', ztrasum  
     245            trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / ztrasum 
     246 
     247            ! Silicate 
     248            ! -------- 
     249            ztrasum = 0.e0 
     250            DO jk = 1, jpk 
     251               DO jj = 1, jpj 
     252                  DO ji = 1, jpi 
     253                     ztrasum = ztrasum + trn(ji,jj,jk,jpsil) * tmask(ji,jj,jk) * tmask_i(ji,jj)   & 
    227254#  if defined key_off_degrad 
    228255                     &              * facvol(ji,jj,jk)   & 
    229256#  endif 
    230257                     &              * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
    231                END DO 
    232             END DO 
    233          END DO 
    234          IF( lk_mpp )   CALL mpp_sum( ztrasum )     ! sum over the global domain   
    235  
    236          ztrasum = ztrasum / areatot * 1.e6 / 7.6 
    237          IF(lwp) WRITE(numout,*) 'NO3 moyen ', ztrasum  
    238          trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / ztrasum 
    239  
    240          ! Silicate 
    241          ! -------- 
    242          ztrasum = 0.e0 
    243          DO jk = 1, jpk 
    244             DO jj = 1, jpj 
    245                DO ji = 1, jpi 
    246                   ztrasum = ztrasum + trn(ji,jj,jk,jpsil) * tmask(ji,jj,jk) * tmask_i(ji,jj)   & 
    247 #  if defined key_off_degrad 
    248                      &              * facvol(ji,jj,jk)   & 
    249 #  endif 
    250                      &              * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
    251                END DO 
    252             END DO 
    253          END DO 
    254          IF( lk_mpp )   CALL mpp_sum( ztrasum )     ! sum over the global domain   
    255  
    256          IF(lwp) WRITE(numout,*) 'SiO3 moyen ', ztrasum / areatot * 1.e6 
    257          ztrasum = ztrasum / areatot * 1.e6 
    258          trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * siomean / ztrasum )  
    259          ! 
    260       ENDIF 
     258                  END DO 
     259               END DO 
     260            END DO 
     261            IF( lk_mpp )   CALL mpp_sum( ztrasum )     ! sum over the global domain   
     262             
     263            IF(lwp) WRITE(numout,*) 'SiO3 moyen ', ztrasum / areatot * 1.e6 
     264            ztrasum = ztrasum / areatot * 1.e6 
     265            trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * siomean / ztrasum )  
     266            ! 
     267         ENDIF 
    261268 
    262269!#if defined key_kriest 
     
    267274!      trn(:,:,:,jpnum) = trn(:,:,:,jppoc) / ( 6. * xkr_massp ) 
    268275!#endif 
    269       !!  Set hi (???) from  total alcalinity, borat (???), akb3 (???) and ak23 (???) 
    270       !!  --------------------------------------------------------------------- 
    271       DO jk = 1, jpk 
    272          DO jj = 1, jpj 
    273             DO ji = 1,jpi 
    274                caralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / ( 1. + 1.e-8 / ( rtrn + akb3(ji,jj,jk) ) ) 
    275                co3    = ( caralk - trn(ji,jj,jk,jpdic) ) *       tmask(ji,jj,jk)   & 
    276                   &   +             0.5e-3               * ( 1.- tmask(ji,jj,jk) ) 
    277                bicarb = 2.* trn(ji,jj,jk,jpdic) - caralk 
    278                hi(ji,jj,jk) = ( ak23(ji,jj,jk) * bicarb / co3 )   *       tmask(ji,jj,jk)   & 
    279                   &         +             1.0e-9                  * ( 1.- tmask(ji,jj,jk) ) 
     276         !!  Set hi (???) from  total alcalinity, borat (???), akb3 (???) and ak23 (???) 
     277         !!  --------------------------------------------------------------------- 
     278         DO jk = 1, jpk 
     279            DO jj = 1, jpj 
     280               DO ji = 1,jpi 
     281                  caralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / ( 1. + 1.e-8 / ( rtrn + akb3(ji,jj,jk) ) ) 
     282                  co3    = ( caralk - trn(ji,jj,jk,jpdic) ) *       tmask(ji,jj,jk)   & 
     283                     &   +             0.5e-3               * ( 1.- tmask(ji,jj,jk) ) 
     284                  bicarb = 2.* trn(ji,jj,jk,jpdic) - caralk 
     285                  hi(ji,jj,jk) = ( ak23(ji,jj,jk) * bicarb / co3 )   *       tmask(ji,jj,jk)   & 
     286                     &         +             1.0e-9                  * ( 1.- tmask(ji,jj,jk) ) 
     287               END DO 
    280288            END DO 
    281289         END DO 
    282       END DO 
    283 # endif 
     290#endif 
    284291 
    285292      CALL iom_close( numrtr ) 
     
    323330         DO jn = 1, jptra 
    324331            CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) 
     332         END DO 
     333 
     334         DO jn = 1, jptra 
    325335            CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 
    326336         END DO 
     
    330340         CALL iom_rstput( kt, nitrst, numrtw, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) ) 
    331341#endif 
     342 
    332343#if defined key_pisces 
    333344         CALL iom_rstput( kt, nitrst, numrtw, 'Silicalim', xksi(:,:) ) 
    334345         CALL iom_rstput( kt, nitrst, numrtw, 'Silicamax', xksimax(:,:) ) 
    335346#endif 
     347 
    336348#if defined key_cfc 
    337349         DO jn = jp_cfc0, jp_cfc1 
     
    340352         END DO 
    341353#endif 
     354 
    342355 
    343356         IF(lwp) WRITE(numout,*) '----TRACER STAT----' 
Note: See TracChangeset for help on using the changeset viewer.