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 1334 – NEMO

Changeset 1334


Ignore:
Timestamp:
2009-03-03T15:07:48+01:00 (15 years ago)
Author:
smasson
Message:

complete work on time origin in outputs (ticket:335) + downward vertical axis (ticket:357)

Location:
trunk/NEMO
Files:
13 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMO/C1D_SRC/diawri_c1d.F90

    r1318 r1334  
    7676      INTEGER ::   ji, jj, ik                        ! dummy loop indices 
    7777      INTEGER ::   iimi, iima, ipk, it, ijmi, ijma   ! temporary integers 
     78      INTEGER ::   itmod                             !  
    7879      REAL(wp) ::   zsto, zout, zmax, zjulian, zdt   ! temporary scalars 
    7980      REAL(wp), DIMENSION(jpi,jpj) ::   zw2d         ! temporary workspace 
     
    109110 
    110111      ! define time axis 
    111       it = kt - nit000 + 1 
     112      it = kt 
     113      itmod = kt - nit000 + 1 
    112114 
    113115 
     
    142144         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit 
    143145            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       & 
    144             &          0, zjulian, zdt, nh_T, nid_T, domain_id=nidom ) 
     146            &          nit000-1, zjulian, zdt, nh_T, nid_T, domain_id=nidom ) 
    145147         CALL histvert( nid_T, "deptht", "Vertical T levels",      &  ! Vertical grid: gdept 
    146             &           "m", ipk, gdept_0, nz_T ) 
     148            &           "m", ipk, gdept_0, nz_T, "down" ) 
    147149         !                                                            ! Index of ocean points 
    148150         CALL wheneq( jpi*jpj*ipk, tmask, 1, 1., ndex_T , ndim_T  )      ! volume 
     
    276278      ! donne le nombre d'elements, et ndex la liste des indices a sortir 
    277279 
    278       IF( lwp .AND. MOD( it, nwrite ) == 0 ) THEN  
     280      IF( lwp .AND. MOD( itmod, nwrite ) == 0 ) THEN  
    279281         WRITE(numout,*) 'dia_wri : write model outputs in NetCDF files at ', kt, 'time-step' 
    280282         WRITE(numout,*) '~~~~~~ ' 
     
    344346 
    345347      !  Create an output files (output.abort.nc) if S < 0 or u > 20 m/s 
    346       IF( kindic < 0 )   CALL dia_wri_state( 'output.abort' ) 
     348      IF( kindic < 0 )   CALL dia_wri_state( 'output.abort', kt ) 
    347349 
    348350      ! 3. Close all files 
  • trunk/NEMO/C1D_SRC/step_c1d.F90

    r1221 r1334  
    113113 
    114114      IF( ninist == 1 ) THEN                          ! Output the initial state and forcings 
    115                         CALL dia_wri_state( 'output.init' )   ;   ninist = 0 
     115                        CALL dia_wri_state( 'output.init', kstp )   ;   ninist = 0 
    116116      ENDIF 
    117117 
  • trunk/NEMO/LIM_SRC_2/limwri_2.F90

    r1312 r1334  
    103103         ENDIF 
    104104         zout     = nwrite * rdt_ice / nn_fsbc 
    105          niter    = 0 
     105         niter    = nit000 - 1 
    106106         zdept(1) = 0. 
    107107          
     
    110110         CALL dia_nam ( clhstnam, nwrite, 'icemod' ) 
    111111         CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit,    & 
    112             &           1, jpi, 1, jpj, 0, zjulian, rdt_ice, nhorid, nice , domain_id=nidom) 
    113          CALL histvert( nice, "deptht", "Vertical T levels", "m", 1, zdept, ndepid) 
     112            &           1, jpi, 1, jpj, nit000-1, zjulian, rdt_ice, nhorid, nice , domain_id=nidom) 
     113         CALL histvert( nice, "deptht", "Vertical T levels", "m", 1, zdept, ndepid, "down") 
    114114         CALL wheneq  ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim) 
    115115          
     
    182182      END DO 
    183183       
    184       IF( ( nn_fsbc * niter + nit000 - 1 ) >= nitend )   CALL histclo( nice )  
     184      IF( ( nn_fsbc * niter ) >= nitend )   CALL histclo( nice )  
    185185      ! 
    186186   END SUBROUTINE lim_wri_2 
  • trunk/NEMO/LIM_SRC_3/limwri.F90

    r1312 r1334  
    112112         nice, nhorid, ndim, niter, ndepid 
    113113      INTEGER , SAVE ::      & 
    114          nicea, nhorida, nitera, ndimitd 
     114         nicea, nhorida, ndimitd 
    115115      INTEGER , DIMENSION( jpij ) , SAVE ::  & 
    116116         ndex51 
     
    141141         ENDIF 
    142142         zout     = nwrite * rdt_ice / nn_fsbc 
    143          niter    = 0 
     143         niter    = nit000 - 1 
    144144         zdept(1) = 0. 
    145145 
     
    147147         zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment 
    148148         CALL dia_nam ( clhstnam, nwrite, 'icemod' ) 
    149          CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit, 1, jpi, 1, jpj, 0, zjulian, rdt_ice, nhorid, nice, domain_id=nidom ) 
    150          CALL histvert( nice, "deptht", "Vertical T levels", "m", 1, zdept, ndepid) 
     149         CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit, 1, jpi, 1, jpj, nit000-1, zjulian, rdt_ice,   & 
     150            &           nhorid, nice, domain_id=nidom ) 
     151         CALL histvert( nice, "deptht", "Vertical T levels", "m", 1, zdept, ndepid, "down") 
    151152         CALL wheneq  ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim) 
    152153 
     
    169170         clop     = "ave(x)" 
    170171         zout     = nwrite * rdt_ice / nn_fsbc 
    171          nitera   = 0 
    172172         zdept(1) = 0. 
    173173 
     
    175175         CALL histbeg ( clhstnama, jpi, glamt, jpj, gphit,         & 
    176176            1, jpi, 1, jpj,        & ! zoom 
    177             0, zjulian, rdt_ice,   & ! time 
     177            nit000 -1, zjulian, rdt_ice,   & ! time 
    178178            nhorida,               & ! ? linked with horizontal ... 
    179179            nicea , domain_id=nidom)                  ! file  
     
    316316      END DO 
    317317 
    318       IF ( ( nn_fsbc * niter + nit000 - 1 ) >= nitend .OR. kindic < 0 ) THEN 
     318      IF ( ( nn_fsbc * niter ) >= nitend .OR. kindic < 0 ) THEN 
    319319         IF( lwp) WRITE(numout,*) ' Closing the icemod file ' 
    320320         CALL histclo( nice ) 
     
    375375         !     not yet implemented 
    376376 
    377          IF ( ( nn_fsbc * niter + nit000 - 1 ) >= nitend .OR. kindic < 0 ) THEN 
     377         IF ( ( nn_fsbc * niter ) >= nitend .OR. kindic < 0 ) THEN 
    378378            IF(lwp) WRITE(numout,*) ' Closing the icemod file ' 
    379379            CALL histclo( nicea )  
  • trunk/NEMO/OPA_SRC/DIA/diagap.F90

    r1317 r1334  
    8282      !! * local declarations 
    8383      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    84       INTEGER ::   it 
     84      INTEGER ::   it, itmod    ! time step indices 
    8585      CHARACTER (len=40) ::   clhstnam 
    8686      CHARACTER (len=40) ::   clop 
     
    170170         ! Horizontal grid : zphi() 
    171171         CALL histbeg( clhstnam, 1, zfoo, 1, zloo,   & 
    172                        1, 1, 1, 1, 0, zjulian, zdt, nhoridg, numgap, domain_id=nidom ) 
     172                       1, 1, 1, 1, nit000-1, zjulian, zdt, nhoridg, numgap, domain_id=nidom ) 
    173173         ! Vertical grids : gdept, gdepw 
    174174         CALL histvert( numgap, "deptht", "Vertical T levels",   & 
    175                          "m", jpk, gdept_0, ndepidg ) 
     175                         "m", jpk, gdept_0, ndepidg, "down" ) 
    176176 
    177177         ! define fields to be stored 
     
    198198      ! ---------------------- 
    199199 
    200       it = kt - nit000 + 1       ! define time axis 
    201       IF( MOD( it, ngap ) == 0 ) THEN 
     200      itmod = kt - nit000 + 1       ! define time axis 
     201      it = kt  
     202      IF( MOD( itmod, ngap ) == 0 ) THEN 
    202203 
    203204         ! initialization 
     
    240241          ! ----------------------------====== 
    241242 
    242           IF( MOD( it, nprg ) == 0 ) THEN 
     243          IF( MOD( itmod, nprg ) == 0 ) THEN 
    243244              IF(lwp) THEN 
    244245                  WRITE(numout,*) 'dia_gap: time step = ', kt, 'model - data' 
  • trunk/NEMO/OPA_SRC/DIA/diaptr.F90

    r1317 r1334  
    418418 
    419419      CHARACTER (len=40)       ::   clhstnam, clop                   ! temporary names 
    420       INTEGER                  ::   iline, it, ji                    ! 
     420      INTEGER                  ::   iline, it, ji, itmod             ! 
    421421      REAL(wp)                 ::   zsto, zout, zdt, zjulian   ! temporary scalars 
    422422      REAL(wp), DIMENSION(jpj) ::   zphi, zfoo 
     
    424424       
    425425      ! define time axis 
    426       it = kt - nit000 + 1 
     426      it = kt 
     427      itmod = kt - nit000 + 1 
    427428 
    428429      ! Initialization 
     
    481482         ! Horizontal grid : zphi() 
    482483         CALL histbeg(clhstnam, 1, zfoo, jpj, zphi,   & 
    483             1, 1, 1, jpj, 0, zjulian, zdt, nhoridz, numptr, domain_id=nidom ) 
     484            1, 1, 1, jpj, nit000-1, zjulian, zdt, nhoridz, numptr, domain_id=nidom ) 
    484485         ! Vertical grids : gdept_0, gdepw_0 
    485486         CALL histvert( numptr, "deptht", "Vertical T levels",   & 
    486             "m", jpk, gdept_0, ndepidzt ) 
     487            "m", jpk, gdept_0, ndepidzt, "down" ) 
    487488         CALL histvert( numptr, "depthw", "Vertical W levels",   & 
    488             "m", jpk, gdepw_0, ndepidzw ) 
     489            "m", jpk, gdepw_0, ndepidzw, "down" ) 
    489490          
    490491         !  Zonal mean T and S 
     
    555556      ENDIF 
    556557 
    557       IF( MOD( it, nf_ptr ) == 0 ) THEN 
     558      IF( MOD( itmod, nf_ptr ) == 0 ) THEN 
    558559 
    559560         IF(lwp) THEN 
  • trunk/NEMO/OPA_SRC/DIA/diawri.F90

    r1318 r1334  
    109109      INTEGER ::   inum = 11             ! temporary logical unit 
    110110      INTEGER ::   & 
    111          iimi, iima, ipk, it,         &  ! temporary integers 
     111         iimi, iima, ipk, it, itmod,  &  ! temporary integers 
    112112         ijmi, ijma                      !    "          " 
    113113      REAL(wp) ::   & 
     
    148148 
    149149      ! define time axis 
    150       it = kt - nit000 + 1 
     150      it = kt 
     151      itmod = kt - nit000 + 1 
    151152 
    152153 
     
    184185         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit 
    185186            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       & 
    186             &          0, zjulian, zdt, nh_T, nid_T, domain_id=nidom ) 
     187            &          nit000-1, zjulian, zdt, nh_T, nid_T, domain_id=nidom ) 
    187188         CALL histvert( nid_T, "deptht", "Vertical T levels",      &  ! Vertical grid: gdept 
    188             &           "m", ipk, gdept_0, nz_T ) 
     189            &           "m", ipk, gdept_0, nz_T, "down" ) 
    189190         !                                                            ! Index of ocean points 
    190191         CALL wheneq( jpi*jpj*ipk, tmask, 1, 1., ndex_T , ndim_T  )      ! volume 
     
    197198         CALL histbeg( clhstnam, jpi, glamu, jpj, gphiu,           &  ! Horizontal grid: glamu and gphiu 
    198199            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       & 
    199             &          0, zjulian, zdt, nh_U, nid_U, domain_id=nidom ) 
     200            &          nit000-1, zjulian, zdt, nh_U, nid_U, domain_id=nidom ) 
    200201         CALL histvert( nid_U, "depthu", "Vertical U levels",      &  ! Vertical grid: gdept 
    201             &           "m", ipk, gdept_0, nz_U ) 
     202            &           "m", ipk, gdept_0, nz_U, "down" ) 
    202203         !                                                            ! Index of ocean points 
    203204         CALL wheneq( jpi*jpj*ipk, umask, 1, 1., ndex_U , ndim_U  )      ! volume 
     
    210211         CALL histbeg( clhstnam, jpi, glamv, jpj, gphiv,           &  ! Horizontal grid: glamv and gphiv 
    211212            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       & 
    212             &          0, zjulian, zdt, nh_V, nid_V, domain_id=nidom ) 
     213            &          nit000-1, zjulian, zdt, nh_V, nid_V, domain_id=nidom ) 
    213214         CALL histvert( nid_V, "depthv", "Vertical V levels",      &  ! Vertical grid : gdept 
    214             &          "m", ipk, gdept_0, nz_V ) 
     215            &          "m", ipk, gdept_0, nz_V, "down" ) 
    215216         !                                                            ! Index of ocean points 
    216217         CALL wheneq( jpi*jpj*ipk, vmask, 1, 1., ndex_V , ndim_V  )      ! volume 
     
    223224         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,           &  ! Horizontal grid: glamt and gphit 
    224225            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,       & 
    225             &          0, zjulian, zdt, nh_W, nid_W, domain_id=nidom ) 
     226            &          nit000-1, zjulian, zdt, nh_W, nid_W, domain_id=nidom ) 
    226227         CALL histvert( nid_W, "depthw", "Vertical W levels",      &  ! Vertical grid: gdepw 
    227             &          "m", ipk, gdepw_0, nz_W ) 
     228            &          "m", ipk, gdepw_0, nz_W, "down" ) 
    228229 
    229230 
     
    406407      ! donne le nombre d'elements, et ndex la liste des indices a sortir 
    407408 
    408       IF( lwp .AND. MOD( it, nwrite ) == 0 ) THEN  
     409      IF( lwp .AND. MOD( itmod, nwrite ) == 0 ) THEN  
    409410         WRITE(numout,*) 'dia_wri : write model outputs in NetCDF files at ', kt, 'time-step' 
    410411         WRITE(numout,*) '~~~~~~ ' 
     
    512513 
    513514      !  Create an output files (output.abort.nc) if S < 0 or u > 20 m/s 
    514       IF( kindic < 0 )   CALL dia_wri_state( 'output.abort' ) 
     515      IF( kindic < 0 )   CALL dia_wri_state( 'output.abort', kt ) 
    515516 
    516517      ! 3. Close all files 
     
    526527 
    527528 
    528    SUBROUTINE dia_wri_state( cdfile_name ) 
     529   SUBROUTINE dia_wri_state( cdfile_name, kt ) 
    529530      !!--------------------------------------------------------------------- 
    530531      !!                 ***  ROUTINE dia_wri_state  *** 
     
    546547      !!---------------------------------------------------------------------- 
    547548      !! * Arguments 
    548       CHARACTER (len=* ), INTENT( in ) ::   & 
    549          cdfile_name      ! name of the file created 
     549      CHARACTER (len=* ), INTENT( in ) ::   cdfile_name      ! name of the file created 
     550      INTEGER           , INTENT( in ) ::   kt               ! ocean time-step index 
    550551 
    551552      !! * Local declarations 
     
    588589      zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment 
    589590      CALL histbeg( clname, jpi, glamt, jpj, gphit,   & 
    590           1, jpi, 1, jpj, 0, zjulian, zdt, nh_i, id_i, domain_id=nidom )          ! Horizontal grid : glamt and gphit 
     591          1, jpi, 1, jpj, nit000-1, zjulian, zdt, nh_i, id_i, domain_id=nidom )          ! Horizontal grid : glamt and gphit 
    591592      CALL histvert( id_i, "deptht", "Vertical T levels",   &    ! Vertical grid : gdept 
    592           "m", jpk, gdept_0, nz_i) 
     593          "m", jpk, gdept_0, nz_i, "down") 
    593594 
    594595      ! Declare all the output fields as NetCDF variables 
     
    634635 
    635636      ! Write all fields on T grid 
    636       CALL histwrite( id_i, "votemper", 1, tn      , jpi*jpj*jpk, idex )    ! now temperature 
    637       CALL histwrite( id_i, "vosaline", 1, sn      , jpi*jpj*jpk, idex )    ! now salinity 
    638 #if defined key_dynspg_rl 
    639       CALL histwrite( id_i, "sobarstf", 1, bsfn     , jpi*jpj    , idex )    ! barotropic streamfunction 
     637      CALL histwrite( id_i, "votemper", kt, tn      , jpi*jpj*jpk, idex )    ! now temperature 
     638      CALL histwrite( id_i, "vosaline", kt, sn      , jpi*jpj*jpk, idex )    ! now salinity 
     639#if defined key_dynspg_rl 
     640      CALL histwrite( id_i, "sobarstf", kt, bsfn     , jpi*jpj    , idex )    ! barotropic streamfunction 
    640641#else 
    641       CALL histwrite( id_i, "sossheig", 1, sshn     , jpi*jpj    , idex )    ! sea surface height 
    642 #endif 
    643       CALL histwrite( id_i, "vozocrtx", 1, un       , jpi*jpj*jpk, idex )    ! now i-velocity 
    644       CALL histwrite( id_i, "vomecrty", 1, vn       , jpi*jpj*jpk, idex )    ! now j-velocity 
    645       CALL histwrite( id_i, "vovecrtz", 1, wn       , jpi*jpj*jpk, idex )    ! now k-velocity 
    646       CALL histwrite( id_i, "sowaflup", 1, emp      , jpi*jpj    , idex )    ! freshwater budget 
    647       CALL histwrite( id_i, "sohefldo", 1, qsr + qns, jpi*jpj    , idex )    ! total heat flux 
    648       CALL histwrite( id_i, "soshfldo", 1, qsr      , jpi*jpj    , idex )    ! solar heat flux 
    649       CALL histwrite( id_i, "soicecov", 1, fr_i     , jpi*jpj    , idex )    ! ice fraction 
    650       CALL histwrite( id_i, "sozotaux", 1, utau     , jpi*jpj    , idex )    ! i-wind stress 
    651       CALL histwrite( id_i, "sometauy", 1, vtau     , jpi*jpj    , idex )    ! j-wind stress 
     642      CALL histwrite( id_i, "sossheig", kt, sshn     , jpi*jpj    , idex )    ! sea surface height 
     643#endif 
     644      CALL histwrite( id_i, "vozocrtx", kt, un       , jpi*jpj*jpk, idex )    ! now i-velocity 
     645      CALL histwrite( id_i, "vomecrty", kt, vn       , jpi*jpj*jpk, idex )    ! now j-velocity 
     646      CALL histwrite( id_i, "vovecrtz", kt, wn       , jpi*jpj*jpk, idex )    ! now k-velocity 
     647      CALL histwrite( id_i, "sowaflup", kt, emp      , jpi*jpj    , idex )    ! freshwater budget 
     648      CALL histwrite( id_i, "sohefldo", kt, qsr + qns, jpi*jpj    , idex )    ! total heat flux 
     649      CALL histwrite( id_i, "soshfldo", kt, qsr      , jpi*jpj    , idex )    ! solar heat flux 
     650      CALL histwrite( id_i, "soicecov", kt, fr_i     , jpi*jpj    , idex )    ! ice fraction 
     651      CALL histwrite( id_i, "sozotaux", kt, utau     , jpi*jpj    , idex )    ! i-wind stress 
     652      CALL histwrite( id_i, "sometauy", kt, vtau     , jpi*jpj    , idex )    ! j-wind stress 
    652653 
    653654      ! 3. Close the file 
  • trunk/NEMO/OPA_SRC/TRD/trdmld.F90

    r1317 r1334  
    230230      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    231231      !! 
    232       INTEGER :: ji, jj, jk, jl, ik, it 
     232      INTEGER :: ji, jj, jk, jl, ik, it, itmod 
    233233      LOGICAL :: lldebug = .TRUE. 
    234234      REAL(wp) :: zavt, zfn, zfn2 
     
    389389      smltrd(:,:,:) = smltrd(:,:,:) * ucf   !  is no longer used, and is reset to 0. at next time step) 
    390390       
    391       it = kt - nit000 + 1 
    392  
    393       MODULO_NTRD : IF( MOD( it, ntrd ) == 0 ) THEN        ! nitend MUST be multiple of ntrd 
     391      ! define time axis 
     392      it = kt 
     393      itmod = kt - nit000 + 1 
     394 
     395      MODULO_NTRD : IF( MOD( itmod, ntrd ) == 0 ) THEN        ! nitend MUST be multiple of ntrd 
    394396         ! 
    395397         ztmltot (:,:) = 0.e0   ;   zsmltot (:,:) = 0.e0   ! reset arrays to zero 
     
    576578#if defined key_dimgout 
    577579 
    578       IF( MOD( it, ntrd ) == 0 ) THEN 
     580      IF( MOD( itmod, ntrd ) == 0 ) THEN 
    579581         iyear =  ndastp/10000 
    580582         imon  = (ndastp-iyear*10000)/100 
     
    593595      ! ---------------------------------- 
    594596 
    595       IF( lwp .AND. MOD( it , ntrd ) == 0 ) THEN 
     597      IF( lwp .AND. MOD( itmod , ntrd ) == 0 ) THEN 
    596598         WRITE(numout,*) ' ' 
    597599         WRITE(numout,*) 'trd_mld : write trends in the NetCDF file :' 
     
    683685#endif 
    684686 
    685       IF( MOD( it, ntrd ) == 0 ) THEN 
     687      IF( MOD( itmod, ntrd ) == 0 ) THEN 
    686688         ! 
    687689         ! III.5 Reset cumulative arrays to zero 
     
    876878      IF(lwp) WRITE(numout,*) ' Name of NETCDF file ', clhstnam 
    877879      CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,                                            & 
    878       &             1, jpi, 1, jpj, 0, zjulian, rdt, nh_t, nidtrd, domain_id=nidom ) 
     880      &             1, jpi, 1, jpj, nit000-1, zjulian, rdt, nh_t, nidtrd, domain_id=nidom ) 
    879881 
    880882      !-- Define the ML depth variable 
  • trunk/NEMO/OPA_SRC/TRD/trdvor.F90

    r1317 r1334  
    312312      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    313313      !! 
    314       INTEGER  ::   ji, jj, jk, jl, it 
     314      INTEGER  ::   ji, jj, jk, jl, it, itmod 
    315315      REAL(wp) ::   zmean 
    316316      REAL(wp), DIMENSION(jpi,jpj) ::   zun, zvn 
     
    406406 
    407407      ! define time axis 
    408       it= kt - nit000 + 1 
     408      it = kt 
     409      itmod = kt - nit000 + 1 
    409410 
    410411      IF( MOD( it, ntrd ) == 0 ) THEN 
     
    455456      IF( kt >=  nit000+1 ) THEN 
    456457 
    457          IF( lwp .AND. MOD( it, ntrd ) == 0 ) THEN 
     458         IF( lwp .AND. MOD( itmod, ntrd ) == 0 ) THEN 
    458459            WRITE(numout,*) '' 
    459460            WRITE(numout,*) 'trd_vor : write trends in the NetCDF file at kt = ', kt 
     
    568569      IF(lwp) WRITE(numout,*) ' Name of NETCDF file ', clhstnam 
    569570      CALL histbeg( clhstnam, jpi, glamf, jpj, gphif,1, jpi,   &  ! Horizontal grid : glamt and gphit 
    570          &          1, jpj, 0, zjulian, rdt, nh_t, nidvor, domain_id=nidom ) 
     571         &          1, jpj, nit000-1, zjulian, rdt, nh_t, nidvor, domain_id=nidom ) 
    571572      CALL wheneq( jpi*jpj, fmask, 1, 1., ndexvor1, ndimvor1 )    ! surface 
    572573 
  • trunk/NEMO/OPA_SRC/step.F90

    r1246 r1334  
    195195 
    196196      IF( ninist == 1 ) THEN                       ! Output the initial state and forcings 
    197                         CALL dia_wri_state( 'output.init' ) 
     197                        CALL dia_wri_state( 'output.init', kstp ) 
    198198                        ninist = 0 
    199199      ENDIF 
  • trunk/NEMO/TOP_SRC/SED/sedwri.F90

    r1329 r1334  
    4040      INTEGER , DIMENSION(jpij) , SAVE :: ndext51 
    4141      REAL(wp) :: zsto,zout, zdt 
    42       INTEGER :: iimi, iima, ijmi, ijma,ipk, it 
     42      INTEGER :: iimi, iima, ijmi, ijma,ipk, it, itmod 
    4343      INTEGER :: jn 
    4444      CHARACTER(len = 20)  ::  cltra , cltrau 
     
    7676 
    7777      ! define time axis 
    78       it = kt - nitsed000 + 1 
     78      it = kt 
     79      itmod = kt - nitsed000 + 1 
    7980 
    8081 
     
    185186         CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit,     & 
    186187            &             iimi, iima-iimi+1, ijmi, ijma-ijmi+1,         & 
    187             &             0, zjulian, zdt,  nhorised, nised , domain_id=nidom ) 
    188          CALL histvert( nised,'deptht','Vertic.sed.T levels','m',ipk, profsed, ndepsed ) 
     188            &             nitsed000-1, zjulian, zdt,  nhorised, nised , domain_id=nidom ) 
     189         CALL histvert( nised,'deptht','Vertic.sed.T levels','m',ipk, profsed, ndepsed, 'down' ) 
    189190         CALL wheneq  ( jpi*jpj*ipk, tmasksed, 1, 1., ndext52, ndimt52 ) 
    190191         CALL wheneq  ( jpi*jpj, tmasksed(:,:,1), 1, 1., ndext51, ndimt51 ) 
  • trunk/NEMO/TOP_SRC/TRP/trdmld_trc.F90

    r1317 r1334  
    406406      !!---------------------------------------------------------------------- 
    407407      INTEGER, INTENT( in ) ::   kt                               ! ocean time-step index 
    408       INTEGER ::   ji, jj, jk, jl, ik, it, jn 
     408      INTEGER ::   ji, jj, jk, jl, ik, it, jn, itmod 
    409409      REAL(wp) ::   zavt, zfn, zfn2 
    410410      !! 
     
    575575      tmltrd_trc(:,:,:,:) = tmltrd_trc(:,:,:,:) * ucf_trc 
    576576 
    577       it = kt - nit000 + 1 
    578  
    579       MODULO_NTRD : IF( MOD( it, ntrd_trc ) == 0 ) THEN           ! nitend MUST be multiple of ntrd_trc 
     577      ! define time axis 
     578      it = kt 
     579      itmod = kt - nit000 + 1 
     580 
     581      MODULO_NTRD : IF( MOD( itmod, ntrd_trc ) == 0 ) THEN           ! nitend MUST be multiple of ntrd_trc 
    580582         ! 
    581583         ztmltot (:,:,:) = 0.e0                                   ! reset arrays to zero 
     
    819821      ! ---------------------------------- 
    820822 
    821       IF( lwp .AND. MOD( it , ntrd_trc ) == 0 ) THEN 
     823      IF( lwp .AND. MOD( itmod , ntrd_trc ) == 0 ) THEN 
    822824         WRITE(numout,*) ' ' 
    823825         WRITE(numout,*) 'trd_mld_trc : write passive tracer trends in the NetCDF file :' 
     
    930932# endif /* key_dimgout */ 
    931933 
    932       IF( MOD( it, ntrd_trc ) == 0 ) THEN 
     934      IF( MOD( itmod, ntrd_trc ) == 0 ) THEN 
    933935         ! 
    934936         ! Reset cumulative arrays to zero 
     
    9991001      INTEGER, INTENT( in ) ::   kt                       ! ocean time-step index 
    10001002#if defined key_lobster 
    1001       INTEGER  ::  jl, it 
     1003      INTEGER  ::  jl, it, itmod 
    10021004      LOGICAL  :: llwarn  = .TRUE., lldebug = .TRUE. 
    10031005      REAL(wp), DIMENSION(jpi,jpj,jpdiabio) ::  ztmltrdbio2  ! only needed for mean diagnostics 
     
    10591061      tmltrd_bio(:,:,:) = tmltrd_bio(:,:,:) * ucf_trc 
    10601062 
    1061       MODULO_NTRD : IF( MOD( kt, ntrd_trc ) == 0 ) THEN      ! nitend MUST be multiple of ntrd 
     1063      ! define time axis 
     1064      it = kt 
     1065      itmod = kt - nit000 + 1 
     1066 
     1067      MODULO_NTRD : IF( MOD( itmod, ntrd_trc ) == 0 ) THEN      ! nitend MUST be multiple of ntrd 
    10621068         ! 
    10631069         zfn  = float(nmoymltrdbio)    ;    zfn2 = zfn * zfn 
     
    11321138 
    11331139      ! define time axis 
    1134       it = kt - nit000 + 1 
    1135  
    1136       IF( lwp .AND. MOD( it , ntrd_trc ) == 0 ) THEN 
     1140      it = kt 
     1141      itmod = kt - nit000 + 1 
     1142 
     1143      IF( lwp .AND. MOD( itmod , ntrd_trc ) == 0 ) THEN 
    11371144         WRITE(numout,*) ' ' 
    11381145         WRITE(numout,*) 'trd_mld_bio : write ML bio trends in the NetCDF file :' 
     
    11741181# endif /* key_dimgout */ 
    11751182 
    1176       IF( MOD( it, ntrd_trc ) == 0 ) THEN 
     1183      IF( MOD( itmod, ntrd_trc ) == 0 ) THEN 
    11771184         ! 
    11781185         ! III.5 Reset cumulative arrays to zero 
     
    14551462            CALL dia_nam( clhstnam, ntrd_trc, csuff ) 
    14561463            CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,                                            & 
    1457                &        1, jpi, 1, jpj, 0, zjulian, rdt, nh_t(jn), nidtrd(jn), domain_id=nidom ) 
     1464               &        1, jpi, 1, jpj, nit000-1, zjulian, rdt, nh_t(jn), nidtrd(jn), domain_id=nidom ) 
    14581465       
    14591466            !-- Define the ML depth variable 
     
    14681475          CALL dia_nam( clhstnam, ntrd_trc, 'trdbio' ) 
    14691476          CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,                                            & 
    1470              &             1, jpi, 1, jpj, 0, zjulian, rdt, nh_tb, nidtrdbio, domain_id=nidom ) 
     1477             &             1, jpi, 1, jpj, nit000-1, zjulian, rdt, nh_tb, nidtrdbio, domain_id=nidom ) 
    14711478#endif 
    14721479 
  • trunk/NEMO/TOP_SRC/trcdia.F90

    r1329 r1334  
    111111      CHARACTER (len=80) :: cltral 
    112112      REAL(wp) :: zsto, zout, zdt 
    113       INTEGER  :: iimi, iima, ijmi, ijma, ipk, it 
     113      INTEGER  :: iimi, iima, ijmi, ijma, ipk, it, itmod 
    114114      !!---------------------------------------------------------------------- 
    115115 
     
    141141 
    142142      ! define time axis 
    143       it = kt - nittrc000 + 1 
     143      it = kt 
     144      itmod = kt - nittrc000 + 1 
    144145 
    145146      ! Define NETCDF files and fields at beginning of first time step 
     
    168169         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,     & 
    169170            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,         &  
    170             &          0, xjulian, zdt, nhorit5, nit5 , domain_id=nidom) 
     171            &          nittrc000-1, xjulian, zdt, nhorit5, nit5 , domain_id=nidom) 
    171172! Vertical grid for tracer : gdept 
    172173         CALL histvert( nit5, 'deptht', 'Vertical T levels', & 
    173             &            'm', ipk, gdept_0, ndepit5) 
     174            &            'm', ipk, gdept_0, ndepit5, 'down') 
    174175 
    175176! Index of ocean points in 3D and 2D (surface) 
     
    201202      ! --------------------------------------- 
    202203 
    203       IF( lwp .AND. MOD( it, nwritetrc ) == 0 ) THEN 
     204      IF( lwp .AND. MOD( itmod, nwritetrc ) == 0 ) THEN 
    204205         WRITE(numout,*) 'trcdit_wr : write NetCDF passive tracer concentrations at ', kt, 'time-step' 
    205206         WRITE(numout,*) '~~~~~~~~~ ' 
     
    246247      CHARACTER (len=10) ::   csuff 
    247248      INTEGER  ::   jn, jl 
    248       INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it 
     249      INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it, itmod 
    249250      REAL(wp) ::   zsto, zout, zdt 
    250251      !!---------------------------------------------------------------------- 
     
    277278 
    278279      ! define time axis 
    279       it = kt - nittrc000 + 1 
     280      it = kt 
     281      itmod = kt - nittrc000 + 1 
    280282 
    281283      ! Define the NETCDF files (one per tracer) 
     
    298300               CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,       & 
    299301                  &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,   & 
    300                   &          0, xjulian, rdt, nhorit6(jn),           & 
     302                  &          nittrc000-1, xjulian, rdt, nhorit6(jn),           & 
    301303                  &          nit6(jn) , domain_id=nidom ) 
    302304 
    303305               ! Vertical grid for tracer trend - one per each tracer IF needed 
    304306               CALL histvert( nit6(jn), 'deptht', 'Vertical T levels',   & 
    305                   &           'm', ipk, gdept_0, ndepit6(jn) )  
     307                  &           'm', ipk, gdept_0, ndepit6(jn), 'down' )  
    306308             END IF 
    307309          END DO 
     
    411413      ! trends for tracer concentrations 
    412414 
    413       IF( lwp .AND. MOD( it, nwritetrd ) == 0 ) THEN 
     415      IF( lwp .AND. MOD( itmod, nwritetrd ) == 0 ) THEN 
    414416         WRITE(numout,*) 'trcdid_wr : write NetCDF dynamical trends at ', kt, 'time-step' 
    415417         WRITE(numout,*) '~~~~~~ ' 
     
    485487      CHARACTER (len=80) ::   cltral 
    486488      INTEGER  ::   jn 
    487       INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it 
     489      INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it, itmod 
    488490      REAL(wp) ::   zsto, zout, zdt 
    489491      !!---------------------------------------------------------------------- 
     
    516518 
    517519      ! define time axis 
    518       it = kt - nittrc000 + 1 
     520      it = kt 
     521      itmod = kt - nittrc000 + 1 
    519522 
    520523      ! 1. Define NETCDF files and fields at beginning of first time step 
     
    536539         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,             & 
    537540            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,         & 
    538             &          0, xjulian, zdt, nhoritd, nitd , domain_id=nidom ) 
     541            &          nittrc000-1, xjulian, zdt, nhoritd, nitd , domain_id=nidom ) 
    539542 
    540543         ! Vertical grid for 2d and 3d arrays 
    541544 
    542545         CALL histvert( nitd, 'deptht', 'Vertical T levels',   & 
    543             &           'm', ipk, gdept_0, ndepitd) 
     546            &           'm', ipk, gdept_0, ndepitd, 'down') 
    544547 
    545548         ! Declare all the output fields as NETCDF variables 
     
    577580      ! --------------------- 
    578581 
    579       IF( lwp .AND. MOD( it, nwritedia ) == 0 ) THEN 
     582      IF( lwp .AND. MOD( itmod, nwritedia ) == 0 ) THEN 
    580583         WRITE(numout,*) 'trcdii_wr : write NetCDF additional arrays at ', kt, 'time-step' 
    581584         WRITE(numout,*) '~~~~~~ ' 
     
    635638      CHARACTER (len=80) ::   cltral 
    636639      INTEGER  ::   ji, jj, jk, jn 
    637       INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it 
     640      INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it, itmod 
    638641      REAL(wp) ::   zsto, zout, zdt 
    639642      !!---------------------------------------------------------------------- 
     
    666669 
    667670      ! define time axis 
    668       it = kt - nittrc000 + 1 
     671      it = kt 
     672      itmod = kt - nittrc000 + 1 
    669673 
    670674      ! Define NETCDF files and fields at beginning of first time step 
     
    680684         IF(lwp)WRITE(numout,*) " Name of NETCDF file for biological trends ", clhstnam 
    681685         ! Horizontal grid : glamt and gphit 
    682         CALL histbeg(clhstnam, jpi, glamt, jpj, gphit,      & 
     686    CALL histbeg(clhstnam, jpi, glamt, jpj, gphit,      & 
    683687            &    iimi, iima-iimi+1, ijmi, ijma-ijmi+1,          & 
    684             &    0, xjulian, rdt, nhoritb, nitb , domain_id=nidom) 
     688            &    nittrc000-1, xjulian, rdt, nhoritb, nitb , domain_id=nidom) 
    685689         ! Vertical grid for biological trends 
    686690         CALL histvert(nitb, 'deptht', 'Vertical T levels',  & 
    687             &    'm', ipk, gdept_0, ndepitb) 
     691            &    'm', ipk, gdept_0, ndepitb, 'down') 
    688692 
    689693         ! Declare all the output fields as NETCDF variables 
     
    710714 
    711715      ! biological trends 
    712       IF( lwp .AND. MOD( it, nwritebio ) == 0 ) THEN 
     716      IF( lwp .AND. MOD( itmod, nwritebio ) == 0 ) THEN 
    713717         WRITE(numout,*) 'trcdit_wr : write NetCDF biological trends at ', kt, 'time-step' 
    714718         WRITE(numout,*) '~~~~~~ ' 
Note: See TracChangeset for help on using the changeset viewer.