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 763 for branches/dev_001_GM/NEMO/TOP_SRC/trcrst.F90 – NEMO

Ignore:
Timestamp:
2007-12-13T14:52:50+01:00 (16 years ago)
Author:
gm
Message:

dev_001_GM - Style only addition in TOP F90 h90 routines

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/dev_001_GM/NEMO/TOP_SRC/trcrst.F90

    r730 r763  
    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_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   !!---------------------------------------------------------------------- 
    1716   USE oce_trc 
    1817   USE trc 
     
    2524   PRIVATE 
    2625    
    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    
    3330   LOGICAL, PUBLIC ::   lrst_trc         !: logical to control the trc restart write  
    3431   INTEGER, PUBLIC ::   numrtr, numrtw   !: logical unit for trc restart (read and write) 
    3532 
    36  
    3733   !! * Substitutions 
    3834#  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   !!---------------------------------------------------------------------- 
    3940    
    4041CONTAINS 
     
    5253      !!---------------------------------------------------------------------- 
    5354      ! 
    54  
    5555      IF( kt == nit000 )  THEN 
    5656         lrst_trc = .FALSE. 
    57 #if defined key_off_tra 
     57# if defined key_off_tra 
    5858         nitrst = nitend  ! in online version, already done in rst_opn routine defined in restart.F90 module 
    59 #endif 
     59# endif 
    6060      ENDIF 
    6161       
     
    6363         ! beware if model runs less than 2*ndttrc time step 
    6464         ! 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 
    6967         ENDIF 
    7068         ! create the file 
     
    8078 
    8179   SUBROUTINE trc_rst_read  
    82       !!=========================================================================================== 
     80      !!---------------------------------------------------------------------- 
     81      !!                    ***  trc_rst_opn  *** 
    8382      !! 
    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 ??? ' 
    141104      ENDIF 
    142105 
    143106      ! Time domain : restart 
    144107      ! ------------------------- 
    145  
    146       IF(lwp) WRITE(numout,*) 
    147108      IF(lwp) WRITE(numout,*) 
    148109      IF(lwp) WRITE(numout,*) ' *** passive tracer restart option' 
     
    168129      IF(lwp) WRITE(numout,*) '   time-step           : ', NINT( zkt    ) 
    169130      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 
    192144      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) )  
    194147      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 
    201149      CALL iom_get( numrtr, jpdom_local, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) )  
    202150      CALL iom_get( numrtr, jpdom_local, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) )  
    203  
    204 #elif defined key_trc_pisces 
     151# elif defined key_trc_pisces 
    205152      CALL iom_get( numrtr, jpdom_local, 'Silicalim', xksi(:,:) )  
    206153      xksimax = xksi 
    207  
    208 #elif defined key_cfc 
     154# elif defined key_cfc 
    209155      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) )  
    211158      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 
    313243 
    314244!#if defined key_trc_kriest 
     
    319249!      trn(:,:,:,jpnum) = trn(:,:,:,jppoc) / ( 6. * xkr_massp ) 
    320250!#endif 
    321       !!  Initialization of chemical variables of the carbon cycle 
    322       !!  -------------------------------------------------------- 
    323       DO jk = 1,jpk 
    324          DO jj = 1,jpj 
     251      !!  Set hi (???) from  total alcalinity, borat (???), akb3 (???) and ak23 (???) 
     252      !!  --------------------------------------------------------------------- 
     253      DO jk = 1, jpk 
     254         DO jj = 1, jpj 
    325255            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 
    337266      trb(:,:,:,:) = trn(:,:,:,:) 
    338267 
    339268      CALL iom_close( numrtr ) 
    340  
    341  
     269      ! 
    342270   END SUBROUTINE trc_rst_read 
    343271 
    344    SUBROUTINE trc_rst_wri(kt) 
    345       !! ================================================================================== 
     272 
     273   SUBROUTINE trc_rst_wri( kt ) 
     274      !!---------------------------------------------------------------------- 
     275      !!                    ***  trc_rst_wri  *** 
    346276      !! 
    347       !!                       ROUTINE trc_rst_wri 
    348       !!                       ****************** 
     277      !! ** purpose  :   write passive tracer fields in restart files 
     278      !!---------------------------------------------------------------------- 
     279      INTEGER, INTENT( in ) ::    kt 
    349280      !! 
    350       !!  PURPOSE : 
    351       !!  --------- 
    352       !!     WRITE restart fields in nutwrs 
    353       !!   METHOD : 
    354       !!   ------- 
    355       !! 
    356       !!   nutwrs FILE: 
    357       !!   each nstock time step , SAVE fields which are necessary for 
    358       !!   passive tracer restart 
    359       !! 
    360       !! 
    361       !!   INPUT : 
    362       !!   ----- 
    363       !!      argument 
    364       !!              kt              : time step 
    365       !!      COMMON 
    366       !!            /cottrc/          : passive tracers fields (before,now 
    367       !!                                  ,after) 
    368       !! 
    369       !!   OUTPUT : 
    370       !!   ------ 
    371       !!      FILE 
    372       !!           nutwrs          : standard restart fields OUTPUT 
    373       !! 
    374       !!   WORKSPACE : 
    375       !!   --------- 
    376       !!      ji,jj,jk,jn 
    377       !! 
    378       !!   History: 
    379       !!   -------- 
    380       !!      original : 96-12 
    381       !!      addition : 99-12 (M.-A. Foujols) NetCDF FORMAT with ioipsl 
    382       !!      additions : 00-05 (A. Estublier) 
    383       !!                  TVD Limiter Scheme : key_trc_tvd 
    384       !!      additions : 01-01 (M.A Foujols, E. Kestenare) bug fix: restclo 
    385       !!      additions : 01-01 (O. Aumont, E. Kestenare) 
    386       !!                  write restart file for sediments 
    387       !!      additions : 01-05 (O. Aumont, E. Kestenare) 
    388       !!                  write restart file for calcite and silicate sediments 
    389       !!   05-03 (O. Aumont and A. El Moussaoui) F90 
    390       !!========================================================================================! 
    391  
    392       !! * Arguments 
    393       !! ----------- 
    394       INTEGER, INTENT( in ) :: kt 
    395  
    396       !! * local declarations 
    397       !! ==================== 
    398  
    399281      INTEGER  :: ji,jj,jk,jn 
    400282      REAL(wp) :: zdiag_var, zdiag_varmin, zdiag_varmax, zdiag_tot 
    401283      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 
    415293         IF(lwp) WRITE(numout,*) '~~~~~~~~~' 
    416294 
     
    427305         ! prognostic variables 
    428306         ! -------------------- 
    429  
    430          DO jn=1,jptra 
     307         DO jn = 1, jptra 
    431308            CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) 
    432          ENDDO 
    433  
    434          DO jn=1,jptra 
    435309            CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 
    436310         END DO 
     
    443317 
    444318#elif defined key_cfc 
    445          DO jn=1,jptra 
     319         DO jn = 1, jptra 
    446320            CALL iom_rstput( kt, nitrst, numrtw, 'qint'//ctrcnm(jn), qint(:,:,jn) ) 
    447          END DO 
    448          DO jn=1,jptra 
    449321            CALL iom_rstput( kt, nitrst, numrtw, 'qtr'//ctrcnm(jn) , qtr( :,:,jn) ) 
    450322         END DO 
    451323#endif 
    452324 
    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)   & 
    465336#if defined key_off_degrad 
    466337                        &   * facvol(ji,jj,jk)   & 
    467338#endif 
    468339                        &   * e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 
    469  
    470340                  END DO 
    471341               END DO 
    472342            END DO 
    473343 
    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.)) ) 
    476346 
    477347            IF( lk_mpp ) THEN 
    478                CALL mpp_min(zdiag_varmin)      ! min over the global domain 
    479                CALL mpp_max(zdiag_varmax)      ! max over the global domain 
    480                CALL mpp_sum(zdiag_var)         ! sum over the global domain 
     348               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 
    481351            END IF 
    482352 
    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 
    489358         END DO 
    490359 
     
    495364 
    496365         CALL iom_close(numrtw) 
    497  
    498       ENDIF 
    499  
     366         ! 
     367      ENDIF 
     368      ! 
    500369   END SUBROUTINE trc_rst_wri 
    501370 
    502  
    503371#else 
    504    !!====================================================================== 
    505    !!  Empty module : No passive tracer 
    506    !!====================================================================== 
     372   !!---------------------------------------------------------------------- 
     373   !!  Dummy module :                                    No passive tracer 
     374   !!---------------------------------------------------------------------- 
    507375CONTAINS 
    508  
    509    SUBROUTINE trc_rst_read 
    510       !! no passive tracers 
     376   SUBROUTINE trc_rst_read                      ! Empty routines 
    511377   END SUBROUTINE trc_rst_read 
    512  
    513    SUBROUTINE trc_rst_wri(kt) 
    514       !! no passive tracers 
     378   SUBROUTINE trc_rst_wri( kt ) 
    515379      INTEGER, INTENT ( in ) :: kt 
    516380      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    
    519382#endif 
    520     
     383 
     384   !!====================================================================== 
    521385END MODULE trcrst 
Note: See TracChangeset for help on using the changeset viewer.