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

Ignore:
Timestamp:
2008-05-14T18:14:53+02:00 (16 years ago)
Author:
cetlod
Message:

Update modules for new version of TOP model, see ticket 144

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMO/TOP_SRC/trcrst.F90

    r899 r945  
    11MODULE trcrst 
    22   !!====================================================================== 
    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 
    85   !!====================================================================== 
    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_top 
     9   !!---------------------------------------------------------------------- 
     10   !!   'key_top'                                                TOP models 
     11   !!---------------------------------------------------------------------- 
     12   !!   trc_rst_opn    : open  restart file 
     13   !!   trc_rst_read   : read  restart file 
     14   !!   trc_rst_wri    : write restart file 
     15   !!---------------------------------------------------------------------- 
    1716   USE oce_trc 
    1817   USE trc 
    1918   USE sms 
     19   USE trcsms_cfc          ! CFC variables 
    2020   USE trctrp_lec    
    2121   USE lib_mpp 
    … …  
    2525   PRIVATE 
    2626    
    27    !! * Accessibility 
    28    PUBLIC trc_rst_opn 
    29    PUBLIC trc_rst_read 
    30    PUBLIC trc_rst_wri 
    31     
    32    !! * Module variables 
     27   PUBLIC   trc_rst_opn       ! called by ??? 
     28   PUBLIC   trc_rst_read      ! called by ??? 
     29   PUBLIC   trc_rst_wri       ! called by ??? 
     30    
    3331   LOGICAL, PUBLIC ::   lrst_trc         !: logical to control the trc restart write  
    3432   INTEGER, PUBLIC ::   numrtr, numrtw   !: logical unit for trc restart (read and write) 
    3533 
     34   REAL(wp) ::  & 
     35     alkmean = 2426. ,  & ! mean value of alkalinity ( Glodap ; for Goyet 2391. ) 
     36     po4mean = 2.165 ,  & ! mean value of phosphates 
     37     no3mean = 30.90 ,  & ! mean value of nitrate 
     38     siomean = 91.51      ! mean value of silicate 
    3639 
    3740   !! * Substitutions 
    38 #  include "passivetrc_substitute.h90" 
     41#  include "top_substitute.h90" 
     42   !!---------------------------------------------------------------------- 
     43   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
     44   !! $Id$  
     45   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
     46   !!---------------------------------------------------------------------- 
    3947    
    4048CONTAINS 
    … …  
    5260      !!---------------------------------------------------------------------- 
    5361      ! 
    54  
    5562      IF( kt == nit000 )  THEN 
    5663         lrst_trc = .FALSE. 
    57 #if defined key_off_tra 
     64# if defined key_off_tra 
    5865         nitrst = nitend  ! in online version, already done in rst_opn routine defined in restart.F90 module 
    59 #endif 
     66# endif 
    6067      ENDIF 
    6168       
    … …  
    6370         ! beware if model runs less than 2*ndttrc time step 
    6471         ! 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 
     72         IF( nitrst > 1.0e9 ) THEN   ;   WRITE(clkt,*       ) nitrst 
     73         ELSE                        ;   WRITE(clkt,'(i8.8)') nitrst 
    6974         ENDIF 
    7075         ! create the file 
    … …  
    8085 
    8186   SUBROUTINE trc_rst_read  
    82       !!=========================================================================================== 
     87      !!---------------------------------------------------------------------- 
     88      !!                    ***  trc_rst_opn  *** 
    8389      !! 
    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_c1d && ( 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,*) ' ' 
    141       ENDIF 
     90      !! ** purpose  :   read passive tracer fields in restart files 
     91      !!---------------------------------------------------------------------- 
     92      INTEGER  ::   jn   
     93      INTEGER  ::   iarak0 
     94      REAL(wp) ::   zkt, zarak0 
     95# if defined key_pisces  
     96      REAL(wp) ::   ztrasum 
     97      INTEGER  ::   ji, jj, jk 
     98      REAL(wp) ::   caralk, bicarb, co3 
     99# endif 
     100      !!---------------------------------------------------------------------- 
     101 
     102      IF(lwp) WRITE(numout,*) 
     103      IF(lwp) WRITE(numout,*) 'trc_rst_read : read the TOP restart file' 
     104      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
     105 
     106      IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN   ;   iarak0 = 1 
     107      ELSE                                           ;   iarak0 = 0 
     108      ENDIF 
     109 
     110      IF(lwp) WRITE(numout,*) 
     111      IF(lwp) WRITE(numout,*) '   the present run starts at the time step nit000 = ', nit000 
     112      IF(lwp .AND. iarak0 == 1 )   WRITE(numout,*) '   and needs previous fields for Arakawa sheme ??? ' 
     113 
    142114 
    143115      ! Time domain : restart 
    144116      ! ------------------------- 
    145  
    146       IF(lwp) WRITE(numout,*) 
    147117      IF(lwp) WRITE(numout,*) 
    148118      IF(lwp) WRITE(numout,*) ' *** passive tracer restart option' 
    149119      SELECT CASE ( nrsttr ) 
    150120      CASE ( 0 ) 
    151          IF(lwp) WRITE(numout,*) ' nrsttr = 0 no control of nit000' 
     121         IF(lwp) WRITE(numout,*) '    nrsttr = 0 no control of nit000' 
    152122      CASE ( 1 ) 
    153          IF(lwp) WRITE(numout,*) ' nrsttr = 1 we control the date of nit000' 
     123         IF(lwp) WRITE(numout,*) '    nrsttr = 1 we control the date of nit000' 
    154124      CASE ( 2 ) 
    155          IF(lwp) WRITE(numout,*) ' nrsttr = 2 the date adatrj is read in restart file' 
     125         IF(lwp) WRITE(numout,*) '    nrsttr = 2 the date adatrj is read in restart file' 
    156126      CASE DEFAULT 
    157127         IF(lwp) WRITE(numout,*) '  ===>>>> nrsttr not equal 0, 1 or 2 : no control of the date' 
    158          IF(lwp) WRITE(numout,*) ' =======                   =========' 
     128         IF(lwp) WRITE(numout,*) '  =======                  =========' 
    159129      END SELECT 
    160130 
    161       CALL iom_open ( 'restart.trc', numrtr, kiolib = jprstlib ) 
     131      CALL iom_open( 'restart.trc', numrtr, kiolib = jprstlib ) 
    162132 
    163133      CALL iom_get( numrtr, 'kt'   , zkt    ) 
    … …  
    166136      IF(lwp) WRITE(numout,*) 
    167137      IF(lwp) WRITE(numout,*) ' Info on the restart file read : ' 
    168       IF(lwp) WRITE(numout,*) '   time-step           : ', NINT( zkt    ) 
    169       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  
     138      IF(lwp) WRITE(numout,*) '    time-step           : ', NINT( zkt    ) 
     139      IF(lwp) WRITE(numout,*) '    arakawa option      : ', NINT( zarak0 ) 
     140 
     141 
     142      IF( nittrc000 - NINT( zkt ) /= 1 .AND. nrsttr /= 0 )  &      ! control of date 
     143         &   CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart', & 
     144         &                  ' verify the restart file or rerun with nrstdt = 0 (namelist)' ) 
     145 
     146      IF( iarak0 /= NINT( zarak0 ) )   &                           ! Control of the scheme 
     147         & CALL ctl_stop( ' ===>>>> : problem with advection scheme', & 
     148         & ' it must be the same type for both restart and previous run', & 
     149         & ' centered or euler '  ) 
     150 
     151 
     152      ! READ prognostic variables and computes diagnostic variable 
    192153      DO jn = 1, jptra 
    193          CALL iom_get( numrtr, jpdom_local, 'TRN'//ctrcnm(jn), trn(:,:,:,jn)   )  
     154         CALL iom_get( numrtr, jpdom_local, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) )  
     155         CALL iom_get( numrtr, jpdom_local, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )  
    194156      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 
     157# if defined key_lobster 
    201158      CALL iom_get( numrtr, jpdom_local, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) )  
    202159      CALL iom_get( numrtr, jpdom_local, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) )  
    203  
    204 #elif defined key_trc_pisces 
     160# elif defined key_pisces 
    205161      CALL iom_get( numrtr, jpdom_local, 'Silicalim', xksi(:,:) )  
    206       xksimax = xksi 
    207  
    208 #elif defined key_cfc 
     162      CALL iom_get( numrtr, jpdom_local, 'Silicamax', xksimax(:,:) ) 
     163# elif defined key_cfc 
    209164      DO jn = 1, jptra 
    210          CALL iom_get( numrtr, jpdom_local, 'qint'//ctrcnm(jn),qint(:,:,jn))  
     165         CALL iom_get( numrtr, jpdom_local, 'qint'//ctrcnm(jn), qint(:,:,jn) )  
     166         CALL iom_get( numrtr, jpdom_local, 'qtr'//ctrcnm(jn) , qtr( :,:,jn) )  
    211167      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_c1d && ( 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 
    313  
    314 !#if defined key_trc_kriest 
     168# endif 
     169 
     170# if defined key_pisces  
     171      !                                                         ! --------------------------- ! 
     172      IF( cp_cfg == "orca" .AND. .NOT. lk_trc_c1d ) THEN      ! ORCA condiguration (not 1D) ! 
     173         !                                                      ! --------------------------- ! 
     174         ! set total alkalinity, phosphate, NO3 & silicate 
     175         ! total alkalinity 
     176         ! ----------------------------------------------- 
     177         ztrasum = 0.e0              
     178         DO jk = 1, jpk 
     179            DO jj = 1, jpj 
     180               DO ji = 1, jpi 
     181                  ztrasum = ztrasum + trn(ji,jj,jk,jptal) * tmask(ji,jj,jk) * tmask_i(ji,jj)  & 
     182#  if defined key_off_degrad 
     183                     &              * facvol(ji,jj,jk)   & 
     184#  endif 
     185                     &              * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
     186               END DO 
     187            END DO 
     188         END DO 
     189         IF( lk_mpp )   CALL mpp_sum( ztrasum )     ! sum over the global domain   
     190 
     191 
     192         ztrasum = ztrasum / areatot * 1.e6 
     193         IF(lwp) WRITE(numout,*) 'TALK moyen ', ztrasum 
     194         trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / ztrasum 
     195 
     196         ! phosphate 
     197         ! --------- 
     198         ztrasum = 0.e0 
     199         DO jk = 1, jpk 
     200            DO jj = 1, jpj 
     201               DO ji = 1, jpi 
     202                  ztrasum = ztrasum + trn(ji,jj,jk,jppo4) * tmask(ji,jj,jk) * tmask_i(ji,jj)  & 
     203#  if defined key_off_degrad 
     204                     &              * facvol(ji,jj,jk)   & 
     205#  endif 
     206                     &              * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
     207               END DO 
     208            END DO 
     209         END DO 
     210         IF( lk_mpp )   CALL mpp_sum( ztrasum )     ! sum over the global domain   
     211 
     212         ztrasum = ztrasum / areatot * 1.e6 / 122. 
     213         IF(lwp) WRITE(numout,*) 'PO4 moyen ', ztrasum  
     214         trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / ztrasum 
     215 
     216         ! NO3 
     217         ! --- 
     218         ztrasum = 0.e0 
     219         DO jk = 1, jpk 
     220            DO jj = 1, jpj 
     221               DO ji = 1, jpi 
     222                  ztrasum = ztrasum + trn(ji,jj,jk,jpno3) * tmask(ji,jj,jk) * tmask_i(ji,jj)  & 
     223#  if defined key_off_degrad 
     224                     &              * facvol(ji,jj,jk)   & 
     225#  endif 
     226                     &              * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
     227               END DO 
     228            END DO 
     229         END DO 
     230         IF( lk_mpp )   CALL mpp_sum( ztrasum )     ! sum over the global domain   
     231 
     232         ztrasum = ztrasum / areatot * 1.e6 / 7.6 
     233         IF(lwp) WRITE(numout,*) 'NO3 moyen ', ztrasum  
     234         trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / ztrasum 
     235 
     236         ! Silicate 
     237         ! -------- 
     238         ztrasum = 0.e0 
     239         DO jk = 1, jpk 
     240            DO jj = 1, jpj 
     241               DO ji = 1, jpi 
     242                  ztrasum = ztrasum + trn(ji,jj,jk,jpsil) * tmask(ji,jj,jk) * tmask_i(ji,jj)   & 
     243#  if defined key_off_degrad 
     244                     &              * facvol(ji,jj,jk)   & 
     245#  endif 
     246                     &              * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
     247               END DO 
     248            END DO 
     249         END DO 
     250         IF( lk_mpp )   CALL mpp_sum( ztrasum )     ! sum over the global domain   
     251 
     252         IF(lwp) WRITE(numout,*) 'SiO3 moyen ', ztrasum / areatot * 1.e6 
     253         ztrasum = ztrasum / areatot * 1.e6 
     254         trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * siomean / ztrasum )  
     255         ! 
     256      ENDIF 
     257 
     258!#if defined key_kriest 
    315259!      !! Initialize number of particles from a standart restart file 
    316260!      !! The name of big organic particles jpgoc has been only change 
    … …  
    319263!      trn(:,:,:,jpnum) = trn(:,:,:,jppoc) / ( 6. * xkr_massp ) 
    320264!#endif 
    321       !!  Initialization of chemical variables of the carbon cycle 
    322       !!  -------------------------------------------------------- 
    323       DO jk = 1,jpk 
    324          DO jj = 1,jpj 
     265      !!  Set hi (???) from  total alcalinity, borat (???), akb3 (???) and ak23 (???) 
     266      !!  --------------------------------------------------------------------- 
     267      DO jk = 1, jpk 
     268         DO jj = 1, jpj 
    325269            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 
    337 !CT comment the line below which doesn't ensure  
    338 !CT restartability of the GYRE_LOBSTER configuration 
    339 !CT      trb(:,:,:,:) = trn(:,:,:,:) 
     270               caralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / ( 1. + 1.e-8 / ( rtrn + akb3(ji,jj,jk) ) ) 
     271               co3    = ( caralk - trn(ji,jj,jk,jpdic) ) *       tmask(ji,jj,jk)   & 
     272                  &   +             0.5e-3               * ( 1.- tmask(ji,jj,jk) ) 
     273               bicarb = 2.* trn(ji,jj,jk,jpdic) - caralk 
     274               hi(ji,jj,jk) = ( ak23(ji,jj,jk) * bicarb / co3 )   *       tmask(ji,jj,jk)   & 
     275                  &         +             1.0e-9                  * ( 1.- tmask(ji,jj,jk) ) 
     276            END DO 
     277         END DO 
     278      END DO 
     279# endif 
    340280 
    341281      CALL iom_close( numrtr ) 
    342  
    343  
     282      ! 
    344283   END SUBROUTINE trc_rst_read 
    345284 
    346    SUBROUTINE trc_rst_wri(kt) 
    347       !! ================================================================================== 
     285 
     286   SUBROUTINE trc_rst_wri( kt ) 
     287      !!---------------------------------------------------------------------- 
     288      !!                    ***  trc_rst_wri  *** 
    348289      !! 
    349       !!                       ROUTINE trc_rst_wri 
    350       !!                       ****************** 
     290      !! ** purpose  :   write passive tracer fields in restart files 
     291      !!---------------------------------------------------------------------- 
     292      INTEGER, INTENT( in ) ::   kt    ! ocean time-step index 
    351293      !! 
    352       !!  PURPOSE : 
    353       !!  --------- 
    354       !!     WRITE restart fields in nutwrs 
    355       !!   METHOD : 
    356       !!   ------- 
    357       !! 
    358       !!   nutwrs FILE: 
    359       !!   each nstock time step , SAVE fields which are necessary for 
    360       !!   passive tracer restart 
    361       !! 
    362       !! 
    363       !!   INPUT : 
    364       !!   ----- 
    365       !!      argument 
    366       !!              kt              : time step 
    367       !!      COMMON 
    368       !!            /cottrc/          : passive tracers fields (before,now 
    369       !!                                  ,after) 
    370       !! 
    371       !!   OUTPUT : 
    372       !!   ------ 
    373       !!      FILE 
    374       !!           nutwrs          : standard restart fields OUTPUT 
    375       !! 
    376       !!   WORKSPACE : 
    377       !!   --------- 
    378       !!      ji,jj,jk,jn 
    379       !! 
    380       !!   History: 
    381       !!   -------- 
    382       !!      original : 96-12 
    383       !!      addition : 99-12 (M.-A. Foujols) NetCDF FORMAT with ioipsl 
    384       !!      additions : 00-05 (A. Estublier) 
    385       !!                  TVD Limiter Scheme : key_trc_tvd 
    386       !!      additions : 01-01 (M.A Foujols, E. Kestenare) bug fix: restclo 
    387       !!      additions : 01-01 (O. Aumont, E. Kestenare) 
    388       !!                  write restart file for sediments 
    389       !!      additions : 01-05 (O. Aumont, E. Kestenare) 
    390       !!                  write restart file for calcite and silicate sediments 
    391       !!   05-03 (O. Aumont and A. El Moussaoui) F90 
    392       !!========================================================================================! 
    393  
    394       !! * Arguments 
    395       !! ----------- 
    396       INTEGER, INTENT( in ) :: kt 
    397  
    398       !! * local declarations 
    399       !! ==================== 
    400  
    401       INTEGER  :: ji,jj,jk,jn 
     294      INTEGER  :: ji, jj, jk, jn 
    402295      REAL(wp) :: zdiag_var, zdiag_varmin, zdiag_varmax, zdiag_tot 
    403296      REAL(wp) :: zder 
    404  
    405  
    406       !! 1. OUTPUT of restart fields (nutwrs) 
    407       !! --------------------------- 
    408  
    409       IF( MOD(kt,nstock) == 0 .OR. kt == nitend ) THEN 
    410  
    411          !! 0. initialisations 
    412          !! ------------------ 
    413  
    414          IF(lwp) WRITE(numout,*) ' ' 
    415          IF(lwp) WRITE(numout,*) 'trc_wri : write the passive tracer restart file in NetCDF format ',   & 
    416             'at it= ',kt,' date= ',ndastp 
    417          IF(lwp) WRITE(numout,*) '~~~~~~~~~' 
     297      !!---------------------------------------------------------------------- 
     298 
     299      IF( MOD( kt, nstock ) == 0 .OR. kt == nitend ) THEN 
     300 
     301         ! 0. initialisations 
     302         ! ------------------ 
     303         IF(lwp) WRITE(numout,*) 
     304         IF(lwp) WRITE(numout,*) 'trc_wri : write the TOP restart file (NetCDF) at it= ', kt, ' date= ', ndastp 
     305         IF(lwp) WRITE(numout,*) '~~~~~~~' 
    418306 
    419307 
    … …  
    429317         ! prognostic variables 
    430318         ! -------------------- 
    431  
    432          DO jn=1,jptra 
     319         DO jn = 1, jptra 
    433320            CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) 
    434          ENDDO 
    435  
    436          DO jn=1,jptra 
    437321            CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 
    438322         END DO 
    439323 
    440 #if defined key_trc_lobster1 
     324#if defined key_lobster 
    441325         CALL iom_rstput( kt, nitrst, numrtw, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) ) 
    442326         CALL iom_rstput( kt, nitrst, numrtw, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) ) 
    443 #elif defined key_trc_pisces 
     327#elif defined key_pisces 
    444328         CALL iom_rstput( kt, nitrst, numrtw, 'Silicalim', xksi(:,:) ) 
     329         CALL iom_rstput( kt, nitrst, numrtw, 'Silicamax', xksimax(:,:) ) 
    445330 
    446331#elif defined key_cfc 
    447          DO jn=1,jptra 
     332         DO jn = 1, jptra 
    448333            CALL iom_rstput( kt, nitrst, numrtw, 'qint'//ctrcnm(jn), qint(:,:,jn) ) 
    449          END DO 
    450          DO jn=1,jptra 
    451             CALL iom_rstput( kt, nitrst, numrtw, 'qtr'//ctrcnm(jn) , qtr( :,:,jn) ) 
     334            CALL iom_rstput( kt, nitrst, numrtw, 'qtr'//ctrcnm(jn) , qtr (:,:,jn) ) 
    452335         END DO 
    453336#endif 
    454337 
    455          IF (lwp) WRITE(numout,*) '----TRACER STAT----' 
    456  
    457          zdiag_tot=0. 
    458          DO jn=1,jptra 
    459             zdiag_var=0. 
    460             zdiag_varmin=0. 
    461             zdiag_varmax=0. 
    462  
    463             DO ji=1, jpi 
    464                DO jj=1, jpj 
    465                   DO jk=1,jpk 
    466                      zdiag_var=zdiag_var+trn(ji,jj,jk,jn)*tmask(ji,jj,jk)*tmask_i(ji,jj)  & 
     338         IF(lwp) WRITE(numout,*) '----TRACER STAT----' 
     339 
     340         zdiag_tot = 0.e0 
     341         DO jn = 1, jptra 
     342            zdiag_var    = 0.e0 
     343            zdiag_varmin = 0.e0 
     344            zdiag_varmax = 0.e0 
     345            DO ji = 1, jpi 
     346               DO jj = 1, jpj 
     347                  DO jk = 1,jpk 
     348                     zdiag_var = zdiag_var + trn(ji,jj,jk,jn) * tmask(ji,jj,jk) * tmask_i(ji,jj)   & 
    467349#if defined key_off_degrad 
    468350                        &   * facvol(ji,jj,jk)   & 
    469351#endif 
    470352                        &   * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
    471  
    472353                  END DO 
    473354               END DO 
    474355            END DO 
    475356 
    476             zdiag_varmin=MINVAL(trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.))) 
    477             zdiag_varmax=MAXVAL(trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.))) 
     357            zdiag_varmin = MINVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 
     358            zdiag_varmax = MAXVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 
    478359 
    479360            IF( lk_mpp ) THEN 
    480                CALL mpp_min(zdiag_varmin)      ! min over the global domain 
    481                CALL mpp_max(zdiag_varmax)      ! max over the global domain 
    482                CALL mpp_sum(zdiag_var)         ! sum over the global domain 
     361               CALL mpp_min( zdiag_varmin )      ! min over the global domain 
     362               CALL mpp_max( zdiag_varmax )      ! max over the global domain 
     363               CALL mpp_sum( zdiag_var    )      ! sum over the global domain 
    483364            END IF 
    484365 
    485             zdiag_tot=zdiag_tot+zdiag_var 
    486             zdiag_var=zdiag_var/areatot 
    487  
    488             IF (lwp) WRITE(numout,*) 'MEAN NO ',jn,ctrcnm(jn),' =',zdiag_var,'MIN= '  & 
    489                ,zdiag_varmin,'MAX= ',zdiag_varmax 
    490  
    491          END DO 
    492  
    493          zdiag_tot=zdiag_tot 
    494          zder=((zdiag_tot-trai)/trai)*100._wp 
    495          IF (lwp) WRITE(numout,*) 'Integral of all tracers over the full domain  =',zdiag_tot 
    496          IF (lwp) WRITE(numout,*) 'Drift of the sum of all tracers =',zder, '%' 
     366            zdiag_tot = zdiag_tot + zdiag_var 
     367            zdiag_var = zdiag_var / areatot 
     368 
     369            IF(lwp) WRITE(numout,*) '   MEAN NO ', jn, ctrcnm(jn), ' = ', zdiag_var,   & 
     370               &                    ' MIN = ', zdiag_varmin, ' MAX = ', zdiag_varmax 
     371         END DO 
     372 
     373         zder = ( ( zdiag_tot - trai ) / ( trai + 1.e-12 )  ) * 100._wp 
     374         IF(lwp) WRITE(numout,*) '   Integral of all tracers over the full domain  = ', zdiag_tot 
     375         IF(lwp) WRITE(numout,*) '   Drift of the sum of all tracers =', zder, ' %' 
    497376 
    498377         CALL iom_close(numrtw) 
    499  
    500       ENDIF 
    501  
     378         ! 
     379      ENDIF 
     380      ! 
    502381   END SUBROUTINE trc_rst_wri 
    503382 
    504  
    505383#else 
    506    !!====================================================================== 
    507    !!  Empty module : No passive tracer 
    508    !!====================================================================== 
     384   !!---------------------------------------------------------------------- 
     385   !!  Dummy module :                                    No passive tracer 
     386   !!---------------------------------------------------------------------- 
    509387CONTAINS 
    510  
    511    SUBROUTINE trc_rst_read 
    512       !! no passive tracers 
     388   SUBROUTINE trc_rst_read                      ! Empty routines 
    513389   END SUBROUTINE trc_rst_read 
    514  
    515    SUBROUTINE trc_rst_wri(kt) 
    516       !! no passive tracers 
     390   SUBROUTINE trc_rst_wri( kt ) 
    517391      INTEGER, INTENT ( in ) :: kt 
    518392      WRITE(*,*) 'trc_rst_wri: You should not have seen this print! error?', kt 
    519    END SUBROUTINE trc_rst_wri 
    520     
     393   END SUBROUTINE trc_rst_wri    
    521394#endif 
    522     
     395 
     396   !!====================================================================== 
    523397END MODULE trcrst 
Note: See TracChangeset for help on using the changeset viewer.