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 3294 for trunk/NEMOGCM/NEMO/TOP_SRC/trcini.F90 – NEMO

Ignore:
Timestamp:
2012-01-28T17:44:18+01:00 (12 years ago)
Author:
rblod
Message:

Merge of 3.4beta into the trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r2715 r3294  
    1616   !!   top_alloc :   allocate the TOP arrays 
    1717   !!---------------------------------------------------------------------- 
    18    USE oce_trc 
    19    USE trc 
    20    USE trcrst 
     18   USE oce_trc         ! shared variables between ocean and passive tracers 
     19   USE trc             ! passive tracers common variables 
     20   USE trcrst          ! passive tracers restart 
    2121   USE trcnam          ! Namelist read 
    2222   USE trcini_cfc      ! CFC      initialisation 
     
    2525   USE trcini_c14b     ! C14 bomb initialisation 
    2626   USE trcini_my_trc   ! MY_TRC   initialisation 
    27    USE trcdta    
    28    USE daymod 
     27   USE trcdta          ! initialisation form files 
     28   USE daymod          ! calendar manager 
    2929   USE zpshde          ! partial step: hor. derivative   (zps_hde routine) 
    3030   USE prtctl_trc      ! Print control passive tracers (prt_ctl_trc_init routine) 
     31   USE trcsub       ! variables to substep passive tracers 
    3132    
    3233   IMPLICIT NONE 
     
    5657      !!                or read data or analytical formulation 
    5758      !!--------------------------------------------------------------------- 
    58       INTEGER ::   jk, jn    ! dummy loop indices 
     59      INTEGER ::   jk, jn, jl    ! dummy loop indices 
    5960      CHARACTER (len=25) :: charout 
     61      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  ztrcdta   ! 4D  workspace 
    6062      !!--------------------------------------------------------------------- 
    61  
     63      ! 
     64      IF( nn_timing == 1 )   CALL timing_start('trc_init') 
     65      ! 
    6266      IF(lwp) WRITE(numout,*) 
    6367      IF(lwp) WRITE(numout,*) 'trc_init : initial set up of the passive tracers' 
     
    6670      CALL top_alloc()              ! allocate TOP arrays 
    6771 
    68       !                             ! masked grid volume 
    69       DO jk = 1, jpk 
    70          cvol(:,:,jk) = e1t(:,:) * e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk)  
    71       END DO 
    72  
    73       !                             ! total volume of the ocean 
    74 #if ! defined key_degrad 
    75       areatot = glob_sum( cvol(:,:,:) ) 
    76 #else 
    77       areatot = glob_sum( cvol(:,:,:) * facvol(:,:,:) )  ! degrad option: reduction by facvol 
    78 #endif 
     72      IF( ln_dm2dc .AND. ( lk_pisces .OR. lk_lobster ) )    & 
     73         &  CALL ctl_stop( ' The diurnal cycle is not compatible with PISCES or LOBSTER  ' ) 
     74 
     75      IF( nn_cla == 1 )   & 
     76         &  CALL ctl_stop( ' Cross Land Advection not yet implemented with passive tracer ; nn_cla must be 0' ) 
    7977 
    8078      CALL trc_nam                  ! read passive tracers namelists 
    81  
    82       !                             ! restart for passive tracer (input) 
     79      ! 
     80      IF(lwp) WRITE(numout,*) 
    8381      IF( ln_rsttr ) THEN 
    84          IF(lwp) WRITE(numout,*) '       read a restart file for passive tracer : ', cn_trcrst_in 
    85          IF(lwp) WRITE(numout,*) ' ' 
    86       ELSE 
    87          IF( lwp .AND. lk_dtatrc ) THEN 
    88             DO jn = 1, jptra 
    89                IF( lutini(jn) )  &                  ! open input FILE only IF lutini(jn) is true 
    90                   &  WRITE(numout,*) ' read an initial file for passive tracer number :', jn, ' traceur : ', ctrcnm(jn)  
    91              END DO 
    92           ENDIF 
    93           IF( lwp ) WRITE(numout,*) 
    94       ENDIF 
    95  
    96       IF( ln_dm2dc .AND. ( lk_pisces .OR. lk_lobster ) )    & 
    97          &       CALL ctl_stop( ' The diurnal cycle is not compatible with PISCES or LOBSTER  ' ) 
    98  
    99       IF( nn_cla == 1 )   & 
    100          &       CALL ctl_stop( ' Cross Land Advection not yet implemented with passive tracer ; nn_cla must be 0' ) 
    101  
    102       IF( lk_lobster ) THEN   ;   CALL trc_ini_lobster      ! LOBSTER bio-model 
    103       ELSE                    ;   IF(lwp) WRITE(numout,*) '          LOBSTER not used' 
    104       ENDIF 
    105        
    106       IF( lk_pisces  ) THEN   ;   CALL trc_ini_pisces       ! PISCES  bio-model 
    107       ELSE                    ;   IF(lwp) WRITE(numout,*) '          PISCES not used' 
    108       ENDIF 
    109        
    110       IF( lk_cfc     ) THEN   ;   CALL trc_ini_cfc          ! CFC     tracers 
    111       ELSE                    ;   IF(lwp) WRITE(numout,*) '          CFC not used' 
    112       ENDIF 
    113  
    114       IF( lk_c14b    ) THEN   ;   CALL trc_ini_c14b         ! C14 bomb  tracer 
    115       ELSE                    ;   IF(lwp) WRITE(numout,*) '          C14 not used' 
    116       ENDIF 
    117        
    118       IF( lk_my_trc  ) THEN   ;   CALL trc_ini_my_trc       ! MY_TRC  tracers 
    119       ELSE                    ;   IF(lwp) WRITE(numout,*) '          MY_TRC not used' 
    120       ENDIF 
    121  
    122       IF( ln_rsttr ) THEN 
    12382        ! 
    12483        IF( lk_offline )  neuler = 1   ! Set time-step indicator at nit000 (leap-frog) 
    125         CALL trc_rst_read              ! restart from a file 
     84        CALL trc_rst_cal( nittrc000, 'READ' )   ! calendar 
    12685        ! 
    12786      ELSE 
     
    13089           CALL day_init               ! set calendar 
    13190        ENDIF 
    132 #if defined key_dtatrc 
    133         CALL trc_dta( nit000 )      ! Initialization of tracer from a file that may also be used for damping 
    134         DO jn = 1, jptra 
    135            IF( lutini(jn) )   trn(:,:,:,jn) = trdta(:,:,:,jn) * tmask(:,:,:)   ! initialisation from file if required 
    136         END DO 
    137 #endif 
     91        ! 
     92      ENDIF 
     93      IF(lwp) WRITE(numout,*) 
     94                                                              ! masked grid volume 
     95      !                                                              ! masked grid volume 
     96      DO jk = 1, jpk 
     97         cvol(:,:,jk) = e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk) 
     98      END DO 
     99      IF( lk_degrad ) cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:)      ! degrad option: reduction by facvol 
     100      !                                                              ! total volume of the ocean  
     101      areatot = glob_sum( cvol(:,:,:) ) 
     102 
     103      IF( lk_lobster )       CALL trc_ini_lobster      ! LOBSTER bio-model 
     104      IF( lk_pisces  )       CALL trc_ini_pisces       ! PISCES  bio-model 
     105      IF( lk_cfc     )       CALL trc_ini_cfc          ! CFC     tracers 
     106      IF( lk_c14b    )       CALL trc_ini_c14b         ! C14 bomb  tracer 
     107      IF( lk_my_trc  )       CALL trc_ini_my_trc       ! MY_TRC  tracers 
     108 
     109      IF( lwp ) THEN 
     110         ! 
     111         CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 
     112         ! 
     113      ENDIF 
     114 
     115      IF( ln_trcdta )      CALL trc_dta_init 
     116 
     117 
     118      IF( ln_rsttr ) THEN 
     119        ! 
     120        CALL trc_rst_read              ! restart from a file 
     121        ! 
     122      ELSE 
     123        ! 
     124        IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN  ! Initialisation of tracer from a file that may also be used for damping 
     125            ! 
     126            CALL wrk_alloc( jpi, jpj, jpk, nb_trcdta, ztrcdta )    ! Memory allocation 
     127            ! 
     128            CALL trc_dta( nit000, ztrcdta )   ! read tracer data at nit000 
     129            ! 
     130            DO jn = 1, jptra 
     131               IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file 
     132                  jl = n_trc_index(jn)  
     133                  trn(:,:,:,jn) = ztrcdta(:,:,:,jl) * tmask(:,:,:)   
     134               ENDIF 
     135            ENDDO 
     136            CALL wrk_dealloc( jpi, jpj, jpk, nb_trcdta, ztrcdta ) 
     137        ENDIF 
     138        ! 
    138139        trb(:,:,:,:) = trn(:,:,:,:) 
    139140        !  
     
    145146        &    CALL zps_hde( nit000, jptra, trn, gtru, gtrv )       ! tracers at the bottom ocean level 
    146147 
    147  
    148       !            
    149       trai = 0._wp         ! Computation content of all tracers 
     148      ! 
     149      IF( nn_dttrc /= 1 )        CALL trc_sub_ini      ! Initialize variables for substepping passive tracers 
     150      ! 
     151 
     152      trai(:) = 0._wp                                                   ! initial content of all tracers 
    150153      DO jn = 1, jptra 
    151 #if ! defined key_degrad 
    152          trai = trai + glob_sum( trn(:,:,:,jn) * cvol(:,:,:) ) 
    153 #else 
    154          trai = trai + glob_sum( trn(:,:,:,jn) * cvol(:,:,:) * facvol(:,:,:) ) ! degrad option: reduction by facvol 
    155 #endif 
    156       END DO       
     154         trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   ) 
     155      END DO 
    157156 
    158157      IF(lwp) THEN               ! control print 
     
    161160         WRITE(numout,*) '          *** Total number of passive tracer jptra = ', jptra 
    162161         WRITE(numout,*) '          *** Total volume of ocean                = ', areatot 
    163          WRITE(numout,*) '          *** Total inital content of all tracers  = ', trai 
    164          WRITE(numout,*) 
    165       ENDIF 
    166  
     162         WRITE(numout,*) '          *** Total inital content of all tracers ' 
     163         WRITE(numout,*) 
     164         DO jn = 1, jptra 
     165            WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn) 
     166         ENDDO 
     167         WRITE(numout,*) 
     168      ENDIF 
     169      IF(lwp) WRITE(numout,*) 
    167170      IF(ln_ctl) THEN            ! print mean trends (used for debugging) 
    168171         CALL prt_ctl_trc_init 
     
    171174         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 
    172175      ENDIF 
     1769000  FORMAT(' tracer nb : ',i2,'      name :',a10,'      initial content :',e18.10) 
     177      ! 
     178      IF( nn_timing == 1 )   CALL timing_stop('trc_init') 
    173179      ! 
    174180   END SUBROUTINE trc_init 
     
    186192      USE trczdf        , ONLY:   trc_zdf_alloc 
    187193      USE trdmod_trc_oce, ONLY:   trd_mod_trc_oce_alloc 
    188 #if ! defined key_iomput 
    189       USE trcdia        , ONLY:   trc_dia_alloc 
    190 #endif 
    191 #if defined key_trcdmp  
    192       USE trcdmp        , ONLY:   trc_dmp_alloc 
    193 #endif 
    194 #if defined key_dtatrc 
    195       USE trcdta        , ONLY:   trc_dta_alloc 
    196 #endif 
    197 #if defined key_trdmld_trc   ||   defined key_esopa 
     194#if defined key_trdmld_trc  
    198195      USE trdmld_trc    , ONLY:   trd_mld_trc_alloc 
    199196#endif 
     
    207204      ierr = ierr + trc_zdf_alloc() 
    208205      ierr = ierr + trd_mod_trc_oce_alloc() 
    209 #if ! defined key_iomput 
    210       ierr = ierr + trc_dia_alloc() 
    211 #endif 
    212 #if defined key_trcdmp  
    213       ierr = ierr + trc_dmp_alloc() 
    214 #endif 
    215 #if defined key_dtatrc 
    216       ierr = ierr + trc_dta_alloc() 
    217 #endif 
    218 #if defined key_trdmld_trc   ||   defined key_esopa 
     206#if defined key_trdmld_trc  
    219207      ierr = ierr + trd_mld_trc_alloc() 
    220208#endif 
Note: See TracChangeset for help on using the changeset viewer.