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 13463 for NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/trcrst.F90 – NEMO

Ignore:
Timestamp:
2020-09-14T17:40:34+02:00 (4 years ago)
Author:
andmirek
Message:

Ticket #2195:update to trunk 13461

Location:
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS

    • Property svn:externals
      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
         8 
         9# SETTE 
         10^/utils/CI/sette@13382        sette 
  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/trcrst.F90

    r10425 r13463  
    3333   PUBLIC   trc_rst_cal 
    3434 
     35#  include "domzgr_substitute.h90" 
    3536   !!---------------------------------------------------------------------- 
    3637   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
     
    5859            IF( ln_rst_list ) THEN 
    5960               nrst_lst = 1 
    60                nitrst = nstocklist( nrst_lst ) 
     61               nitrst = nn_stocklist( nrst_lst ) 
    6162            ELSE 
    6263               nitrst = nitend 
     
    6465         ENDIF 
    6566 
    66          IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN 
     67         IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nn_stock ) == 0 ) THEN 
    6768            ! we use kt - 1 and not kt - nittrc000 to keep the same periodicity from the beginning of the experiment 
    68             nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing 
     69            nitrst = kt + nn_stock - 1                  ! define the next value of nitrst for restart writing 
    6970            IF( nitrst > nitend )   nitrst = nitend   ! make sure we write a restart at the end of the run 
    7071         ENDIF 
     
    7374      ENDIF 
    7475 
     76      IF( .NOT. ln_rst_list .AND. nn_stock == -1 )   RETURN   ! we will never do any restart 
     77 
    7578      ! to get better performances with NetCDF format: 
    76       ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 2*nn_dttrc + 1) 
    77       ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 2*nn_dttrc + 1 
    78       IF( kt == nitrst - 2*nn_dttrc .OR. nstock == nn_dttrc .OR. ( kt == nitend - nn_dttrc .AND. .NOT. lrst_trc ) ) THEN 
     79      ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 1) 
     80      ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 1 
     81      IF( kt == nitrst - 1 .OR. nn_stock == 1 .OR. ( kt == nitend - 1 .AND. .NOT. lrst_trc ) ) THEN 
    7982         ! beware of the format used to write kt (default is i8.8, that should be large enough) 
    8083         IF( nitrst > 1.0e9 ) THEN   ;   WRITE(clkt,*       ) nitrst 
     
    9497   END SUBROUTINE trc_rst_opn 
    9598 
    96    SUBROUTINE trc_rst_read 
     99   SUBROUTINE trc_rst_read( Kbb, Kmm ) 
    97100      !!---------------------------------------------------------------------- 
    98101      !!                    ***  trc_rst_opn  *** 
     
    100103      !! ** purpose  :   read passive tracer fields in restart files 
    101104      !!---------------------------------------------------------------------- 
     105      INTEGER, INTENT( in ) ::   Kbb, Kmm  ! time level indices 
    102106      INTEGER  ::  jn      
    103107 
     
    110114      ! READ prognostic variables and computes diagnostic variable 
    111115      DO jn = 1, jptra 
    112          CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) 
    113       END DO 
    114  
    115       DO jn = 1, jptra 
    116          CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 
     116         CALL iom_get( numrtr, jpdom_auto, 'TRN'//ctrcnm(jn), tr(:,:,:,jn,Kmm) ) 
     117      END DO 
     118 
     119      DO jn = 1, jptra 
     120         CALL iom_get( numrtr, jpdom_auto, 'TRB'//ctrcnm(jn), tr(:,:,:,jn,Kbb) ) 
    117121      END DO 
    118122      ! 
     
    121125   END SUBROUTINE trc_rst_read 
    122126 
    123    SUBROUTINE trc_rst_wri( kt ) 
     127   SUBROUTINE trc_rst_wri( kt, Kbb, Kmm, Krhs ) 
    124128      !!---------------------------------------------------------------------- 
    125129      !!                    ***  trc_rst_wri  *** 
     
    127131      !! ** purpose  :   write passive tracer fields in restart files 
    128132      !!---------------------------------------------------------------------- 
    129       INTEGER, INTENT( in ) ::   kt    ! ocean time-step index 
     133      INTEGER, INTENT( in ) ::   kt              ! ocean time-step index 
     134      INTEGER, INTENT( in ) ::   Kbb, Kmm, Krhs  ! time level indices 
    130135      !! 
    131136      INTEGER  :: jn 
    132137      !!---------------------------------------------------------------------- 
    133138      ! 
    134       CALL iom_rstput( kt, nitrst, numrtw, 'rdttrc1', rdttrc )   ! passive tracer time step 
     139      CALL iom_rstput( kt, nitrst, numrtw, 'rdttrc1', rn_Dt )   ! passive tracer time step (= ocean time step) 
    135140      ! prognostic variables  
    136141      ! --------------------  
    137142      DO jn = 1, jptra 
    138          CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) 
    139       END DO 
    140  
    141       DO jn = 1, jptra 
    142          CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 
     143         CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), tr(:,:,:,jn,Kmm) ) 
     144      END DO 
     145 
     146      DO jn = 1, jptra 
     147         CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), tr(:,:,:,jn,Kbb) ) 
    143148      END DO 
    144149      ! 
     
    146151     
    147152      IF( kt == nitrst ) THEN 
    148           CALL trc_rst_stat            ! statistics 
     153          CALL trc_rst_stat( Kmm, Krhs )             ! statistics 
    149154          CALL iom_close( numrtw )     ! close the restart file (only at last time step) 
    150155#if ! defined key_trdmxl_trc 
     
    153158          IF( l_offline .AND. ln_rst_list ) THEN 
    154159             nrst_lst = nrst_lst + 1 
    155              nitrst = nstocklist( nrst_lst ) 
     160             nitrst = nn_stocklist( nrst_lst ) 
    156161          ENDIF 
    157162      ENDIF 
     
    179184      !!       In both those options, the  exact duration of the experiment 
    180185      !!       since the beginning (cumulated duration of all previous restart runs) 
    181       !!       is not stored in the restart and is assumed to be (nittrc000-1)*rdt. 
     186      !!       is not stored in the restart and is assumed to be (nittrc000-1)*rn_Dt. 
    182187      !!       This is valid is the time step has remained constant. 
    183188      !! 
     
    217222            ENDIF 
    218223            ! Control of date  
    219             IF( nittrc000  - NINT( zkt ) /= nn_dttrc .AND.  nn_rsttr /= 0 )                                  & 
     224            IF( nittrc000  - NINT( zkt ) /= 1 .AND.  nn_rsttr /= 0 )                                  & 
    220225               &   CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart',                 & 
    221226               &                  ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' ) 
     
    259264               nminute = ( nn_time0 - nhour * 100 ) 
    260265               IF( nhour*3600+nminute*60-ndt05 .lt. 0 )  ndastp=ndastp-1      ! Start hour is specified in the namelist (default 0) 
    261                adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday 
     266               adatrj = ( REAL( nit000-1, wp ) * rn_Dt ) / rday 
    262267               ! note this is wrong if time step has changed during run 
    263268            ENDIF 
     
    272277            ENDIF 
    273278            ! 
    274             IF( ln_rsttr )  THEN   ;    neuler = 1 
    275             ELSE                   ;    neuler = 0 
     279            IF( ln_rsttr )  THEN   ;    l_1st_euler = .false. 
     280            ELSE                   ;    l_1st_euler = .true. 
    276281            ENDIF 
    277282            ! 
     
    297302 
    298303 
    299    SUBROUTINE trc_rst_stat 
     304   SUBROUTINE trc_rst_stat( Kmm, Krhs ) 
    300305      !!---------------------------------------------------------------------- 
    301306      !!                    ***  trc_rst_stat  *** 
     
    303308      !! ** purpose  :   Compute tracers statistics 
    304309      !!---------------------------------------------------------------------- 
     310      INTEGER, INTENT( in ) ::   Kmm, Krhs  ! time level indices 
    305311      INTEGER  :: jk, jn 
    306312      REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift 
     
    315321      ! 
    316322      DO jk = 1, jpk 
    317          zvol(:,:,jk) = e1e2t(:,:) * e3t_a(:,:,jk) * tmask(:,:,jk) 
    318       END DO 
    319       ! 
    320       DO jn = 1, jptra 
    321          ztraf = glob_sum( 'trcrst', trn(:,:,:,jn) * zvol(:,:,:) ) 
    322          zmin  = MINVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 
    323          zmax  = MAXVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 
     323         zvol(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Krhs) * tmask(:,:,jk) 
     324      END DO 
     325      ! 
     326      DO jn = 1, jptra 
     327         ztraf = glob_sum( 'trcrst', tr(:,:,:,jn,Kmm) * zvol(:,:,:) ) 
     328         zmin  = MINVAL( tr(:,:,:,jn,Kmm), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 
     329         zmax  = MAXVAL( tr(:,:,:,jn,Kmm), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 
    324330         IF( lk_mpp ) THEN 
    325331            CALL mpp_min( 'trcrst', zmin )      ! min over the global domain 
     
    341347   !!---------------------------------------------------------------------- 
    342348CONTAINS 
    343    SUBROUTINE trc_rst_read                      ! Empty routines 
     349   SUBROUTINE trc_rst_read( Kbb, Kmm)                      ! Empty routines 
     350      INTEGER, INTENT( in ) :: Kbb, Kmm  ! time level indices 
    344351   END SUBROUTINE trc_rst_read 
    345    SUBROUTINE trc_rst_wri( kt ) 
    346       INTEGER, INTENT ( in ) :: kt 
     352   SUBROUTINE trc_rst_wri( kt, Kbb, Kmm, Krhs ) 
     353      INTEGER, INTENT( in ) :: kt 
     354      INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs  ! time level indices 
    347355      WRITE(*,*) 'trc_rst_wri: You should not have seen this print! error?', kt 
    348356   END SUBROUTINE trc_rst_wri    
Note: See TracChangeset for help on using the changeset viewer.