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

Changeset 3192


Ignore:
Timestamp:
2011-12-05T14:55:12+01:00 (12 years ago)
Author:
cetlod
Message:

Perform the initialisation phase of PISCES at nit000 rather than nittrc000

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

Legend:

Unmodified
Added
Removed
  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zflx.F90

    r3160 r3192  
    305305      t_oce_co2_flx = 0._wp 
    306306      ! 
     307      CALL p4z_patm( nit000 ) 
     308      ! 
    307309   END SUBROUTINE p4z_flx_init 
    308310 
     
    326328 
    327329      !                                         ! -------------------- ! 
    328       IF( kt == nittrc000 ) THEN                   ! First call kt=nittrc000 ! 
     330      IF( kt == nit000 ) THEN                   ! First call kt=nittrc000 ! 
    329331         !                                      ! -------------------- ! 
    330332         !                                            !* set file information (default values) 
  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zlys.F90

    r3160 r3192  
    6161      INTEGER, INTENT(in) ::   kt ! ocean time step 
    6262      INTEGER  ::   ji, jj, jk, jn 
    63       REAL(wp) ::   zalk, zdic, zph, zremco3, zah2 
     63      REAL(wp) ::   zalk, zdic, zph, zah2 
    6464      REAL(wp) ::   zdispot, zfact, zcalcon, zalka, zaldi 
    6565      REAL(wp) ::   zomegaca, zexcess, zexcess0 
  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsed.F90

    r3160 r3192  
    340340      IF( nn_timing == 1 )  CALL timing_start('p4z_sbc') 
    341341      ! 
    342       ! Compute dust at nittrc000 or only if there is more than 1 time record in dust file 
     342      ! Compute dust at nit000 or only if there is more than 1 time record in dust file 
    343343      IF( ln_dust ) THEN 
    344          IF( kt == nittrc000 .OR. ( kt /= nittrc000 .AND. ntimes_dust > 1 ) ) THEN 
     344         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_dust > 1 ) ) THEN 
    345345            CALL fld_read( kt, 1, sf_dust ) 
    346346            dust(:,:) = sf_dust(1)%fnow(:,:,1) 
     
    349349 
    350350      ! N/P and Si releases due to coastal rivers 
    351       ! Compute river at nittrc000 or only if there is more than 1 time record in river file 
     351      ! Compute river at nit000 or only if there is more than 1 time record in river file 
    352352      ! ----------------------------------------- 
    353353      IF( ln_river ) THEN 
    354          IF( kt == nittrc000 .OR. ( kt /= nittrc000 .AND. ntimes_riv > 1 ) ) THEN 
     354         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_riv > 1 ) ) THEN 
    355355            CALL fld_read( kt, 1, sf_riverdic ) 
    356356            CALL fld_read( kt, 1, sf_riverdoc ) 
     
    365365      ENDIF 
    366366 
    367       ! Compute N deposition at nittrc000 or only if there is more than 1 time record in N deposition file 
     367      ! Compute N deposition at nit000 or only if there is more than 1 time record in N deposition file 
    368368      IF( ln_ndepo ) THEN 
    369          IF( kt == nittrc000 .OR. ( kt /= nittrc000 .AND. ntimes_ndep > 1 ) ) THEN 
     369         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_ndep > 1 ) ) THEN 
    370370            CALL fld_read( kt, 1, sf_ndepo ) 
    371371            DO jj = 1, jpj 
     
    597597      ENDIF 
    598598      ! 
     599      IF( ll_sbc ) CALL p4z_sbc( nit000 )  
     600      ! 
    599601      IF(lwp) THEN  
    600602         WRITE(numout,*) 
  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90

    r2977 r3192  
    2626   USE p4zflx          !  Gas exchange 
    2727   USE p4zsed          !  Sedimentation 
     28   USE p4zlim          !  Co-limitations of differents nutrients 
     29   USE p4zprod         !  Growth rate of the 2 phyto groups 
     30   USE p4zmicro        !  Sources and sinks of microzooplankton 
     31   USE p4zmeso         !  Sources and sinks of mesozooplankton 
     32   USE p4zmort         !  Mortality terms for phytoplankton 
     33   USE p4zlys          !  Calcite saturation 
     34   USE p4zsed          !  Sedimentation 
    2835 
    2936   IMPLICIT NONE 
     
    5562      !!---------------------------------------------------------------------- 
    5663      ! 
     64      INTEGER  ::  ji, jj, jk 
     65      REAL(wp) ::  zcaralk, zbicarb, zco3 
     66      REAL(wp) ::  ztmas, ztmas1 
     67      !!---------------------------------------------------------------------- 
    5768      IF(lwp) WRITE(numout,*) 
    5869      IF(lwp) WRITE(numout,*) ' trc_ini_pisces :   PISCES biochemical model initialisation' 
     
    123134      ENDIF 
    124135 
     136      IF( .NOT. ln_rsttr ) THEN 
     137         ! Initialization of chemical variables of the carbon cycle 
     138         ! -------------------------------------------------------- 
     139         DO jk = 1, jpk 
     140            DO jj = 1, jpj 
     141               DO ji = 1, jpi 
     142                  ztmas   = tmask(ji,jj,jk) 
     143                  ztmas1  = 1. - tmask(ji,jj,jk) 
     144                  zcaralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / (  1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) )  ) 
     145                  zco3    = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1 
     146                  zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk ) 
     147                  hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1 
     148               END DO 
     149            END DO 
     150         END DO 
     151         ! 
     152      END IF 
     153 
     154      ! Time step duration for biology 
     155      xstep = rfact2 / rday 
     156 
     157      CALL p4z_sink_init      !  vertical flux of particulate organic matter 
     158      CALL p4z_opt_init       !  Optic: PAR in the water column 
     159      CALL p4z_lim_init       !  co-limitations by the various nutrients 
     160      CALL p4z_prod_init      !  phytoplankton growth rate over the global ocean. 
     161      CALL p4z_rem_init       !  remineralisation 
     162      CALL p4z_mort_init      !  phytoplankton mortality  
     163      CALL p4z_micro_init     !  microzooplankton 
     164      CALL p4z_meso_init      !  mesozooplankton 
     165      CALL p4z_sed_init       !  sedimentation  
     166      CALL p4z_lys_init       !  calcite saturation 
     167      CALL p4z_flx_init       !  gas exchange  
     168 
     169      ndayflxtr = 0 
     170 
    125171      IF(lwp) WRITE(numout,*) 'Initialization of PISCES tracers done' 
    126172      IF(lwp) WRITE(numout,*) ' ' 
     
    135181      !! ** Purpose :   Allocate all the dynamic arrays of PISCES  
    136182      !!---------------------------------------------------------------------- 
    137       USE p4zsink , ONLY : p4z_sink_alloc       
    138       USE p4zopt  , ONLY : p4z_opt_alloc            
    139       USE p4zprod , ONLY : p4z_prod_alloc          
    140       USE p4zrem  , ONLY : p4z_rem_alloc            
    141       USE p4zsed  , ONLY : p4z_sed_alloc           
    142       USE p4zflx  , ONLY : p4z_flx_alloc 
    143183      ! 
    144184      INTEGER :: ierr 
  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/PISCES/trcsms_pisces.F90

    r3175 r3192  
    1818   USE p4zbio          !  Biological model 
    1919   USE p4zche          !  Chemical model 
    20    USE p4zsink         !  vertical flux of particulate matter due to sinking 
    21    USE p4zopt          !  optical model 
    22    USE p4zlim          !  Co-limitations of differents nutrients 
    23    USE p4zprod         !  Growth rate of the 2 phyto groups 
    24    USE p4zmort         !  Mortality terms for phytoplankton 
    25    USE p4zmicro        !  Sources and sinks of microzooplankton 
    26    USE p4zmeso         !  Sources and sinks of mesozooplankton 
    27    USE p4zrem          !  Remineralisation of organic matter 
    2820   USE p4zlys          !  Calcite saturation 
    2921   USE p4zflx          !  Gas exchange 
     
    7466      IF( nn_timing == 1 )  CALL timing_start('trc_sms_pisces') 
    7567      ! 
    76       IF( kt == nittrc000 )                                        CALL trc_sms_pisces_init       ! Initialization (first time-step only) 
    7768      IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 )   CALL trc_sms_pisces_dmp( kt )  ! Relaxation of some tracers 
    78                                                                    CALL trc_sms_pisces_mass_conserv( kt ) 
     69                                                                   CALL trc_sms_pisces_mass_conserv( kt ) ! Mass conservation checking 
    7970 
    8071      IF( ndayflxtr /= nday_year ) THEN      ! New days 
     
    176167 
    177168   END SUBROUTINE trc_sms_pisces_dmp 
    178  
    179    SUBROUTINE trc_sms_pisces_init 
    180       !!---------------------------------------------------------------------- 
    181       !!                  ***  ROUTINE trc_sms_pisces_init  *** 
    182       !! 
    183       !! ** Purpose :   Initialization of PH variable 
    184       !! 
    185       !!---------------------------------------------------------------------- 
    186       INTEGER  ::  ji, jj, jk 
    187       REAL(wp) ::  zcaralk, zbicarb, zco3 
    188       REAL(wp) ::  ztmas, ztmas1 
    189  
    190       IF( .NOT. ln_rsttr ) THEN 
    191          ! Initialization of chemical variables of the carbon cycle 
    192          ! -------------------------------------------------------- 
    193          DO jk = 1, jpk 
    194             DO jj = 1, jpj 
    195                DO ji = 1, jpi 
    196                   ztmas   = tmask(ji,jj,jk) 
    197                   ztmas1  = 1. - tmask(ji,jj,jk) 
    198                   zcaralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / (  1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) )  ) 
    199                   zco3    = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1 
    200                   zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk ) 
    201                   hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1 
    202                END DO 
    203             END DO 
    204          END DO 
    205          ! 
    206       END IF 
    207  
    208       ! Time step duration for biology 
    209       xstep = rfact2 / rday 
    210  
    211       CALL p4z_sink_init      !  vertical flux of particulate organic matter 
    212       CALL p4z_opt_init       !  Optic: PAR in the water column 
    213       CALL p4z_lim_init       !  co-limitations by the various nutrients 
    214       CALL p4z_prod_init      !  phytoplankton growth rate over the global ocean.  
    215       CALL p4z_rem_init       !  remineralisation 
    216       CALL p4z_mort_init      !  phytoplankton mortality 
    217       CALL p4z_micro_init     !  microzooplankton 
    218       CALL p4z_meso_init      !  mesozooplankton 
    219       CALL p4z_sed_init       !  sedimentation 
    220       CALL p4z_lys_init       !  calcite saturation 
    221       CALL p4z_flx_init       !  gas exchange 
    222  
    223       ndayflxtr = 0 
    224  
    225    END SUBROUTINE trc_sms_pisces_init 
    226169 
    227170   SUBROUTINE trc_sms_pisces_mass_conserv ( kt ) 
     
    277220         ENDIF 
    278221       ENDIF 
    279  9500  FORMAT(i6,e18.10)      
     222 9500  FORMAT(i10,e18.10)      
    280223       ! 
    281224   END SUBROUTINE trc_sms_pisces_mass_conserv 
  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/trc.F90

    r3175 r3192  
    7979   !! additional 2D/3D outputs namelist 
    8080   !! -------------------------------------------------- 
    81    REAL(wp)           , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,  :) ::  trc2d          !: additional 2d outputs array  
    82    REAL(wp)           , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  trc3d          !: additional 3d outputs array  
    83    CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  ctrc2d         !: 2d field short name 
    84    CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  ctrc2l         !: 2d field long name 
    85    CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  ctrc2u         !: 2d field unit 
    86    CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  ctrc3d         !: 3d field short name 
    87    CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  ctrc3l         !: 3d field long name 
    88    CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  ctrc3u         !: 3d field unit 
     81   REAL(wp)           , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,  :) ::   trc2d         !: additional 2d outputs array  
     82   REAL(wp)           , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   trc3d         !: additional 3d outputs array  
     83   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc2d        !: 2d field short name 
     84   CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc2l        !: 2d field long name 
     85   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc2u        !: 2d field unit 
     86   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc3d        !: 3d field short name 
     87   CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc3l        !: 3d field long name 
     88   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc3u        !: 3d field unit 
    8989   LOGICAL            , PUBLIC                                        ::  ln_diatrc      !: boolean term for additional diagnostic 
    9090   INTEGER            , PUBLIC                                        ::  nn_writedia    !: frequency of additional outputs 
     
    105105   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  tsn_tm      !: t/s average     [m/s] 
    106106   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avt_tm      !: vertical diffusivity coeff. at  w-point   [m2/s] 
    107    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  rhop_tm     !: Density 
     107   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  rhop_tm     !:  
    108108# if defined key_zdfddm 
    109109   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avs_tm      !: vertical double diffusivity coeff. at w-point   [m/s] 
     
    163163   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  tsn_temp 
    164164   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  un_temp,vn_temp,wn_temp     !: hold current values of avt, un, vn, wn 
    165    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avt_temp, rhop_temp      
     165   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avt_temp, rhop_temp     !: hold current values of avt, un, vn, wn 
    166166   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  e3t_temp,e3u_temp,e3v_temp,e3w_temp     !: hold current values 
    167167   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshn_temp, sshb_temp, ssha_temp, rnf_temp,h_rnf_temp 
  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/trcdta.F90

    r3160 r3192  
    183183         IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==! 
    184184            ! 
    185             IF( kt == nittrc000 .AND. lwp )THEN 
     185            IF( kt == nit000 .AND. lwp )THEN 
    186186               WRITE(numout,*) 
    187187               WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh' 
     
    238238         ENDDO  
    239239         ! 
    240          IF( lwp .AND. kt == nittrc000 ) THEN 
     240         IF( lwp .AND. kt == nit000 ) THEN 
    241241            DO jn = 1, ntra 
    242242               clndta = TRIM( sf_trcdta(jn)%clvar )  
  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r3174 r3192  
    7777 
    7878      CALL trc_nam                  ! read passive tracers namelists 
     79      !                                                              ! masked grid volume 
     80      DO jk = 1, jpk 
     81         cvol(:,:,jk) = e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk) 
     82      END DO 
     83      IF( lk_degrad ) cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:)      ! degrad option: reduction by facvol 
     84      !                                                              ! total volume of the ocean  
     85      areatot = glob_sum( cvol(:,:,:) ) 
    7986 
    8087      IF( lk_lobster ) THEN   ;   CALL trc_ini_lobster      ! LOBSTER bio-model 
     
    139146      IF( ln_zps .AND. .NOT. lk_c1d )   &              ! Partial steps: before horizontal gradient of passive 
    140147        &    CALL zps_hde( nit000, jptra, trn, gtru, gtrv )       ! tracers at the bottom ocean level 
    141       !                                                              ! masked grid volume 
    142       DO jk = 1, jpk 
    143          cvol(:,:,jk) = e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk) 
    144       END DO 
    145       IF( lk_degrad ) cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:)      ! degrad option: reduction by facvol 
    146       !                                                              ! total volume of the ocean  
    147       areatot = glob_sum( cvol(:,:,:) ) 
    148148 
    149149      ! 
  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/trcstp.F90

    r3175 r3192  
    9898      END DO 
    9999      IF( lwp ) WRITE(numstr,9300) kt,  ztrai / areatot 
    100 9300  FORMAT(i6,e18.10) 
     1009300  FORMAT(i10,e18.10) 
    101101      ! 
    102102      IF( nn_timing == 1 )   CALL timing_stop('trc_stp') 
  • branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/TOP_SRC/trcsub.F90

    r3175 r3192  
    172172         wn_temp    (:,:,:)      = wn    (:,:,:) 
    173173         tsn_temp   (:,:,:,:)    = tsn   (:,:,:,:) 
    174          rhop_temp  (:,:,:)      = rhop  (:,:,:) 
     174         rhop_temp  (:,:,:)      = rhop  (:,:,:)     
    175175         avt_temp   (:,:,:)      = avt   (:,:,:) 
    176176# if defined key_zdfddm 
    177          avs_temp(:,:,:)         = avs   (:,:,:) 
     177         avs_temp   (:,:,:)      = avs   (:,:,:) 
    178178# endif 
    179179#if defined key_ldfslp 
     
    474474         CALL lbc_lnk( avt   (:,:,:)       , 'W', 1. )  
    475475# if defined key_zdfddm 
    476          CALL lbc_lnk( avs  (:,:,:)       , 'W', 1. )  
     476          CALL lbc_lnk( avs  (:,:,:)       , 'W', 1. )  
    477477# endif 
    478478#if defined key_ldfslp 
     
    10351035      ALLOCATE( un_temp(jpi,jpj,jpk)        ,  vn_temp(jpi,jpj,jpk)  ,   & 
    10361036         &      wn_temp(jpi,jpj,jpk)        ,  avt_temp(jpi,jpj,jpk) ,   & 
     1037         &      rhop_temp(jpi,jpj,jpk)      ,  rhop_tm(jpi,jpj,jpk) ,   & 
    10371038         &      sshn_temp(jpi,jpj)          ,  sshb_temp(jpi,jpj) ,      & 
    10381039         &      ssha_temp(jpi,jpj)          ,  sshu_a_temp(jpi,jpj),     & 
     
    10591060         &      avs_tm(jpi,jpj,jpk)         ,  avs_temp(jpi,jpj,jpk) ,   & 
    10601061# endif 
    1061          &      rhop_tm(jpi,jpj,jpk)        ,  rhop_temp(jpi,jpj,jpk) ,  & 
    10621062#if defined key_traldf_c3d 
    10631063         &      ahtt_tm(jpi,jpj,jpk)        ,  ahtt_temp(jpi,jpj,jpk),   & 
Note: See TracChangeset for help on using the changeset viewer.