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

Changeset 3124


Ignore:
Timestamp:
2011-11-16T10:25:18+01:00 (12 years ago)
Author:
cetlod
Message:

dev_NEMO_MERGE_2011/NEMOGCM:minor modifications on the use of nittrc000 + style corrections

Location:
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC
Files:
18 edited

Legend:

Unmodified
Added
Removed
  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/C14b/trcnam_c14b.F90

    r2977 r3124  
    3838      !! 
    3939      !! ** Method  :   Read the namc14 namelist and check the parameter  
    40       !!       values called at the first timestep (nit000) 
     40      !!       values called at the first timestep (nittrc000) 
    4141      !! 
    4242      !! ** input   :   Namelist namelist_c14b 
  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcexp.F90

    r3116 r3124  
    126126      ! Time filter and swap of arrays 
    127127      ! ------------------------------ 
    128       IF( neuler == 0 .AND. kt == nit000 ) THEN        ! Euler time-stepping at first time-step 
     128      IF( neuler == 0 .AND. kt == nittrc000 ) THEN        ! Euler time-stepping at first time-step 
    129129        !                                             ! (only swap) 
    130130        sedpocn(:,:) = sedpoca(:,:) 
  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zflx.F90

    r3028 r3124  
    252252      !! 
    253253      !! ** Method  :   Read the nampisext namelist and check the parameters 
    254       !!      called at the first timestep (nit000) 
     254      !!      called at the first timestep (nittrc000) 
    255255      !! ** input   :   Namelist nampisext 
    256256      !!---------------------------------------------------------------------- 
     
    326326 
    327327      !                                         ! -------------------- ! 
    328       IF( kt == nit000 ) THEN                   ! First call kt=nit000 ! 
     328      IF( kt == nittrc000 ) THEN                   ! First call kt=nittrc000 ! 
    329329         !                                      ! -------------------- ! 
    330330         !                                            !* set file information (default values) 
  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zlim.F90

    r2977 r3124  
    182182      !! 
    183183      !! ** Method  :   Read the nampislim namelist and check the parameters 
    184       !!      called at the first timestep (nit000) 
     184      !!      called at the first timestep (nittrc000) 
    185185      !! 
    186186      !! ** input   :   Namelist nampislim 
  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zlys.F90

    r2977 r3124  
    181181      !! 
    182182      !! ** Method  :   Read the nampiscal namelist and check the parameters 
    183       !!      called at the first timestep (nit000) 
     183      !!      called at the first timestep (nittrc000) 
    184184      !! 
    185185      !! ** input   :   Namelist nampiscal 
  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmeso.F90

    r2977 r3124  
    237237      !! 
    238238      !! ** Method  :   Read the nampismes namelist and check the parameters 
    239       !!      called at the first timestep (nit000) 
     239      !!      called at the first timestep (nittrc000) 
    240240      !! 
    241241      !! ** input   :   Namelist nampismes 
  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmicro.F90

    r2977 r3124  
    201201      !! 
    202202      !! ** Method  :   Read the nampiszoo namelist and check the parameters 
    203       !!                called at the first timestep (nit000) 
     203      !!                called at the first timestep (nittrc000) 
    204204      !! 
    205205      !! ** input   :   Namelist nampiszoo 
  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zprod.F90

    r2979 r3124  
    466466      !! 
    467467      !! ** Method  :   Read the nampisprod namelist and check the parameters 
    468       !!      called at the first timestep (nit000) 
     468      !!      called at the first timestep (nittrc000) 
    469469      !! 
    470470      !! ** input   :   Namelist nampisprod 
  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsed.F90

    r2977 r3124  
    337337      !!--------------------------------------------------------------------- 
    338338 
    339       ! Compute dust at nit000 or only if there is more than 1 time record in dust file 
     339      ! Compute dust at nittrc000 or only if there is more than 1 time record in dust file 
    340340      IF( ln_dust ) THEN 
    341          IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_dust > 1 ) ) THEN 
     341         IF( kt == nittrc000 .OR. ( kt /= nittrc000 .AND. ntimes_dust > 1 ) ) THEN 
    342342            CALL fld_read( kt, 1, sf_dust ) 
    343343            dust(:,:) = sf_dust(1)%fnow(:,:,1) 
     
    346346 
    347347      ! N/P and Si releases due to coastal rivers 
    348       ! Compute river at nit000 or only if there is more than 1 time record in river file 
     348      ! Compute river at nittrc000 or only if there is more than 1 time record in river file 
    349349      ! ----------------------------------------- 
    350350      IF( ln_river ) THEN 
    351          IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_riv > 1 ) ) THEN 
     351         IF( kt == nittrc000 .OR. ( kt /= nittrc000 .AND. ntimes_riv > 1 ) ) THEN 
    352352            CALL fld_read( kt, 1, sf_riverdic ) 
    353353            CALL fld_read( kt, 1, sf_riverdoc ) 
     
    362362      ENDIF 
    363363 
    364       ! Compute N deposition at nit000 or only if there is more than 1 time record in N deposition file 
     364      ! Compute N deposition at nittrc000 or only if there is more than 1 time record in N deposition file 
    365365      IF( ln_ndepo ) THEN 
    366          IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_ndep > 1 ) ) THEN 
     366         IF( kt == nittrc000 .OR. ( kt /= nittrc000 .AND. ntimes_ndep > 1 ) ) THEN 
    367367            CALL fld_read( kt, 1, sf_ndepo ) 
    368368            DO jj = 1, jpj 
     
    384384      !! 
    385385      !! ** method  :   read the files and compute the budget 
    386       !!                called at the first timestep (nit000) 
     386      !!                called at the first timestep (nittrc000) 
    387387      !! 
    388388      !! ** input   :   external netcdf files 
  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/PISCES/trcrst_pisces.F90

    r2977 r3124  
    195195        ENDIF 
    196196        ! 
    197         CALL trc_dta( nit000, ztrcdta )   ! read tracer data at nit000 
     197        CALL trc_dta( nittrc000, ztrcdta )   ! read tracer data at nittrc000 
    198198        ! 
    199199        DO jn = 1, jptra 
  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90

    r3116 r3124  
    8585      IF( neuler == 0 .AND. kt == nittrc000 ) THEN     ! at nittrc000 
    8686         r2dt(:) =  rdttrc(:)           ! = rdttrc (restarting with Euler time stepping) 
    87       ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN          ! at nittrc000 or nittrc000+1 
     87      ELSEIF( kt <= nittrc000 + 1 ) THEN          ! at nittrc000 or nittrc000+1 
    8888         r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog) 
    8989      ENDIF 
  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90

    r3116 r3124  
    119119 
    120120      ! set time step size (Euler/Leapfrog) 
    121       IF( neuler == 0 .AND. kt ==  nittrc000) THEN  ;  r2dt(:) =     rdttrc(:)   ! at nittrc000             (Euler) 
    122       ELSEIF( kt <= nittrc000 +  nn_dttrc )           THEN  ;  r2dt(:) = 2.* rdttrc(:)   ! at nit000 or nit000+1 (Leapfrog) 
     121      IF( neuler == 0 .AND. kt ==  nittrc000 ) THEN  ;  r2dt(:) =     rdttrc(:)   ! at nittrc000             (Euler) 
     122      ELSEIF( kt <= nittrc000 + 1 )            THEN  ;  r2dt(:) = 2.* rdttrc(:)   ! at nit000 or nit000+1 (Leapfrog) 
    123123      ENDIF 
    124124 
     
    139139      ELSE 
    140140         ! Leap-Frog + Asselin filter time stepping 
    141          IF( lk_vvl ) THEN   ;   CALL tra_nxt_vvl( kt,nittrc000, 'TRC', trb, trn, tra, jptra )      ! variable volume level (vvl)  
    142          ELSE                ;   CALL tra_nxt_fix( kt,nittrc000, 'TRC', trb, trn, tra, jptra )      ! fixed    volume level  
     141         IF( lk_vvl ) THEN   ;   CALL tra_nxt_vvl( kt, nittrc000, 'TRC', trb, trn, tra, jptra )      ! variable volume level (vvl)  
     142         ELSE                ;   CALL tra_nxt_fix( kt, nittrc000, 'TRC', trb, trn, tra, jptra )      ! fixed    volume level  
    143143         ENDIF 
    144144      ENDIF 
  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90

    r3116 r3124  
    188188            IF( l_trdtrc ) THEN 
    189189               ! 
    190                zs2rdt = 1. / ( 2. * rdt * FLOAT(nn_dttrc) ) 
     190               zs2rdt = 1. / ( 2. * rdt * FLOAT( nn_dttrc ) ) 
    191191               ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 
    192192               ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt  
  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90

    r3116 r3124  
    7474      IF( neuler == 0 .AND. kt == nittrc000 ) THEN     ! at nittrc000 
    7575         r2dt(:) =  rdttrc(:)           ! = rdttrc (restarting with Euler time stepping) 
    76       ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN          ! at nittrc000 or nittrc000+nn_dttrc 
     76      ELSEIF( kt <= nittrc000 + 1 ) THEN          ! at nittrc000 or nittrc000+1 
    7777         r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog) 
    7878      ENDIF 
     
    8888      SELECT CASE ( nzdf )                       ! compute lateral mixing trend and add it to the general trend 
    8989      CASE ( -1 )                                       ! esopa: test all possibility with control print 
    90          CALL tra_zdf_exp( kt,nittrc000, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra )  
     90         CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra )  
    9191         WRITE(charout, FMT="('zdf1 ')") ;  CALL prt_ctl_trc_info(charout) 
    9292                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    93          CALL tra_zdf_imp( kt,nittrc000, 'TRC', r2dt,                trb, tra, jptra )  
     93         CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dt,                trb, tra, jptra )  
    9494         WRITE(charout, FMT="('zdf2 ')") ;  CALL prt_ctl_trc_info(charout) 
    9595                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    96       CASE ( 0 ) ;  CALL tra_zdf_exp( kt,nittrc000, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra )    !   explicit scheme  
    97       CASE ( 1 ) ;  CALL tra_zdf_imp( kt,nittrc000, 'TRC', r2dt,                trb, tra, jptra )    !   implicit scheme           
     96      CASE ( 0 ) ;  CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra )    !   explicit scheme  
     97      CASE ( 1 ) ;  CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dt,                trb, tra, jptra )    !   implicit scheme           
    9898 
    9999      END SELECT 
  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/trcdia.F90

    r3116 r3124  
    7171      !!--------------------------------------------------------------------- 
    7272      ! 
    73       IF( kt == nit000 )  THEN 
     73      IF( kt == nittrc000 )  THEN 
    7474         ALLOCATE( ndext50(jpij*jpk), ndext51(jpij), STAT=ierr ) 
    7575         IF( ierr > 0 ) THEN 
     
    145145      itmod = kt - nittrc000 + 1 
    146146      it    = kt 
    147       iiter = ( nit000 - 1 ) / nn_dttrc 
     147      iiter = ( nittrc000 - 1 ) / nn_dttrc 
    148148 
    149149      ! Define NETCDF files and fields at beginning of first time step 
     
    292292      itmod = kt - nittrc000 + 1 
    293293      it    = kt 
    294       iiter = ( nit000 - 1 ) / nn_dttrc 
     294      iiter = ( nittrc000 - 1 ) / nn_dttrc 
    295295 
    296296      ! 1. Define NETCDF files and fields at beginning of first time step 
     
    433433      itmod = kt - nittrc000 + 1 
    434434      it    = kt 
    435       iiter = ( nit000 - 1 ) / nn_dttrc 
     435      iiter = ( nittrc000 - 1 ) / nn_dttrc 
    436436 
    437437      ! Define NETCDF files and fields at beginning of first time step 
  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/trcdta.F90

    r2977 r3124  
    177177         IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==! 
    178178            ! 
    179             IF( kt == nit000 .AND. lwp )THEN 
     179            IF( kt == nittrc000 .AND. lwp )THEN 
    180180               WRITE(numout,*) 
    181181               WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh' 
     
    232232         ENDDO  
    233233         ! 
    234          IF( lwp .AND. kt == nit000 ) THEN 
     234         IF( lwp .AND. kt == nittrc000 ) THEN 
    235235            DO jn = 1, ntra 
    236236               clndta = TRIM( sf_trcdta(jn)%clvar )  
  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r3116 r3124  
    121121            ENDIF 
    122122            ! 
    123             CALL trc_dta( nit000, ztrcdta )   ! read tracer data at nit000 
     123            CALL trc_dta( nittrc000, ztrcdta )   ! read tracer data at nittrc000 
    124124            ! 
    125125            DO jn = 1, jptra 
  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

    r3116 r3124  
    6666 
    6767         IF( MOD( kt - 1, nstock ) == 0 ) THEN 
    68             ! we use kt - 1 and not kt - nit000 to keep the same periodicity from the beginning of the experiment 
     68            ! we use kt - 1 and not kt - nittrc000 to keep the same periodicity from the beginning of the experiment 
    6969            nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing 
    7070            IF( nitrst > nitend )   nitrst = nitend   ! make sure we write a restart at the end of the run 
     
    200200      !!       In both those options, the  exact duration of the experiment 
    201201      !!       since the beginning (cumulated duration of all previous restart runs) 
    202       !!       is not stored in the restart and is assumed to be (nit000-1)*rdt. 
     202      !!       is not stored in the restart and is assumed to be (nittrc000-1)*rdt. 
    203203      !!       This is valid is the time step has remained constant. 
    204204      !! 
Note: See TracChangeset for help on using the changeset viewer.