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 6041 for branches/2015/dev_r5776_UKMO2_OBS_efficiency_improvs/NEMOGCM/NEMO/TOP_SRC/trcini.F90 – NEMO

Ignore:
Timestamp:
2015-12-14T10:06:06+01:00 (8 years ago)
Author:
timgraham
Message:

Merged head of trunk into branch

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5776_UKMO2_OBS_efficiency_improvs/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r5407 r6041  
    1818   USE oce_trc         ! shared variables between ocean and passive tracers 
    1919   USE trc             ! passive tracers common variables 
    20    USE trcrst          ! passive tracers restart 
    2120   USE trcnam          ! Namelist read 
    22    USE trcini_cfc      ! CFC      initialisation 
    23    USE trcini_pisces   ! PISCES   initialisation 
    24    USE trcini_c14b     ! C14 bomb initialisation 
    25    USE trcini_my_trc   ! MY_TRC   initialisation 
    26    USE trcdta          ! initialisation from files 
    2721   USE daymod          ! calendar manager 
    28    USE zpshde          ! partial step: hor. derivative   (zps_hde routine) 
    2922   USE prtctl_trc      ! Print control passive tracers (prt_ctl_trc_init routine) 
    3023   USE trcsub          ! variables to substep passive tracers 
     24   USE trcrst 
    3125   USE lib_mpp         ! distribued memory computing library 
    3226   USE sbc_oce 
     
    5953      !!                or read data or analytical formulation 
    6054      !!--------------------------------------------------------------------- 
    61       INTEGER ::   jk, jn, jl    ! dummy loop indices 
    62       CHARACTER (len=25) :: charout 
    63       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta   ! 4D  workspace 
    64       !!--------------------------------------------------------------------- 
    6555      ! 
    6656      IF( nn_timing == 1 )   CALL timing_start('trc_init') 
     
    7060      IF(lwp) WRITE(numout,*) '~~~~~~~' 
    7161 
    72       CALL top_alloc()              ! allocate TOP arrays 
    73  
     62      ! 
     63      CALL top_alloc()   ! allocate TOP arrays 
     64      ! 
     65      CALL trc_ini_ctl   ! control  
     66      ! 
     67      CALL trc_nam       ! read passive tracers namelists 
     68      ! 
     69      IF(lwp) WRITE(numout,*) 
     70      ! 
     71      IF( ln_rsttr .AND. .NOT. lk_offline ) CALL trc_rst_cal( nit000, 'READ' )   ! calendar 
     72      ! 
     73      IF(lwp) WRITE(numout,*) 
     74      ! 
     75      CALL trc_ini_sms   ! SMS 
     76      ! 
     77      CALL trc_ini_trp   ! passive tracers transport 
     78      ! 
     79      CALL trc_ice_ini   ! Tracers in sea ice 
     80      ! 
     81      IF( lwp )  & 
     82         &  CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp , narea ) 
     83      ! 
     84      CALL trc_ini_state  !  passive tracers initialisation : from a restart or from clim 
     85      ! 
     86      IF( nn_dttrc /= 1 )        CALL trc_sub_ini      ! Initialize variables for substepping passive tracers 
     87      ! 
     88      CALL trc_ini_inv   ! Inventories 
     89      ! 
     90      IF( nn_timing == 1 )   CALL timing_stop('trc_init') 
     91      ! 
     92   END SUBROUTINE trc_init 
     93 
     94 
     95   SUBROUTINE trc_ini_ctl 
     96      !!---------------------------------------------------------------------- 
     97      !!                     ***  ROUTINE trc_ini_ctl  *** 
     98      !! ** Purpose :        Control  + ocean volume 
     99      !!---------------------------------------------------------------------- 
     100      INTEGER ::   jk    ! dummy loop indices 
     101      ! 
     102      ! Define logical parameter ton control dirunal cycle in TOP 
    74103      l_trcdm2dc = ln_dm2dc .OR. ( ln_cpl .AND. ncpl_qsr_freq /= 1 ) 
    75104      l_trcdm2dc = l_trcdm2dc  .AND. .NOT. lk_offline 
    76       IF( l_trcdm2dc .AND. lwp ) & 
    77          &   CALL ctl_warn(' Coupling with passive tracers and used of diurnal cycle. & 
    78          & Computation of a daily mean shortwave for some biogeochemical models) ') 
    79  
    80       IF( nn_cla == 1 )   & 
    81          &  CALL ctl_stop( ' Cross Land Advection not yet implemented with passive tracer ; nn_cla must be 0' ) 
    82  
    83       CALL trc_nam      ! read passive tracers namelists 
    84       ! 
    85       IF(lwp) WRITE(numout,*) 
    86       ! 
    87       IF( ln_rsttr .AND. .NOT. lk_offline ) CALL trc_rst_cal( nit000, 'READ' )   ! calendar 
    88       ! 
    89       IF(lwp) WRITE(numout,*) 
    90                                                               ! masked grid volume 
     105      IF( l_trcdm2dc .AND. lwp )   CALL ctl_warn( 'Coupling with passive tracers and used of diurnal cycle.',   & 
     106         &                           'Computation of a daily mean shortwave for some biogeochemical models ' ) 
     107      ! 
     108   END SUBROUTINE trc_ini_ctl 
     109 
     110 
     111   SUBROUTINE trc_ini_inv 
     112      !!---------------------------------------------------------------------- 
     113      !!                     ***  ROUTINE trc_ini_stat  *** 
     114      !! ** Purpose :      passive tracers inventories at initialsation phase 
     115      !!---------------------------------------------------------------------- 
     116      INTEGER ::  jk, jn    ! dummy loop indices 
     117      CHARACTER (len=25) :: charout 
     118      !!---------------------------------------------------------------------- 
    91119      !                                                              ! masked grid volume 
    92120      DO jk = 1, jpk 
     
    96124      !                                                              ! total volume of the ocean  
    97125      areatot = glob_sum( cvol(:,:,:) ) 
    98  
     126      ! 
     127      trai(:) = 0._wp                                                   ! initial content of all tracers 
     128      DO jn = 1, jptra 
     129         trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   ) 
     130      END DO 
     131 
     132      IF(lwp) THEN               ! control print 
     133         WRITE(numout,*) 
     134         WRITE(numout,*) 
     135         WRITE(numout,*) '          *** Total number of passive tracer jptra = ', jptra 
     136         WRITE(numout,*) '          *** Total volume of ocean                = ', areatot 
     137         WRITE(numout,*) '          *** Total inital content of all tracers ' 
     138         WRITE(numout,*) 
     139         DO jn = 1, jptra 
     140            WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn) 
     141         ENDDO 
     142         WRITE(numout,*) 
     143      ENDIF 
     144      IF(lwp) WRITE(numout,*) 
     145      IF(ln_ctl) THEN            ! print mean trends (used for debugging) 
     146         CALL prt_ctl_trc_init 
     147         WRITE(charout, FMT="('ini ')") 
     148         CALL prt_ctl_trc_info( charout ) 
     149         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 
     150      ENDIF 
     1519000  FORMAT(' tracer nb : ',i2,'      name :',a10,'      initial content :',e18.10) 
     152      ! 
     153   END SUBROUTINE trc_ini_inv 
     154 
     155 
     156   SUBROUTINE trc_ini_sms 
     157      !!---------------------------------------------------------------------- 
     158      !!                     ***  ROUTINE trc_ini_sms  *** 
     159      !! ** Purpose :   SMS initialisation 
     160      !!---------------------------------------------------------------------- 
     161      USE trcini_cfc      ! CFC      initialisation 
     162      USE trcini_pisces   ! PISCES   initialisation 
     163      USE trcini_c14b     ! C14 bomb initialisation 
     164      USE trcini_my_trc   ! MY_TRC   initialisation 
     165      !!---------------------------------------------------------------------- 
    99166      IF( lk_pisces  )       CALL trc_ini_pisces       ! PISCES  bio-model 
    100167      IF( lk_cfc     )       CALL trc_ini_cfc          ! CFC     tracers 
    101168      IF( lk_c14b    )       CALL trc_ini_c14b         ! C14 bomb  tracer 
    102169      IF( lk_my_trc  )       CALL trc_ini_my_trc       ! MY_TRC  tracers 
    103  
    104       CALL trc_ice_ini                                 ! Tracers in sea ice 
    105  
    106       IF( lwp ) THEN 
    107          ! 
    108          CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp , narea ) 
    109          ! 
    110       ENDIF 
    111  
     170      ! 
     171   END SUBROUTINE trc_ini_sms 
     172 
     173   SUBROUTINE trc_ini_trp 
     174      !!---------------------------------------------------------------------- 
     175      !!                     ***  ROUTINE trc_ini_trp  *** 
     176      !! 
     177      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules 
     178      !!---------------------------------------------------------------------- 
     179      USE trcdmp , ONLY:  trc_dmp_ini 
     180      USE trcadv , ONLY:  trc_adv_ini 
     181      USE trcldf , ONLY:  trc_ldf_ini 
     182      USE trczdf , ONLY:  trc_zdf_ini 
     183      USE trcrad , ONLY:  trc_rad_ini 
     184      ! 
     185      INTEGER :: ierr 
     186      !!---------------------------------------------------------------------- 
     187      ! 
     188      IF( ln_trcdmp )  CALL  trc_dmp_ini          ! damping 
     189                       CALL  trc_adv_ini          ! advection 
     190                       CALL  trc_ldf_ini          ! lateral diffusion 
     191                       CALL  trc_zdf_ini          ! vertical diffusion 
     192                       CALL  trc_rad_ini          ! positivity of passive tracers  
     193      ! 
     194   END SUBROUTINE trc_ini_trp 
     195 
     196 
     197   SUBROUTINE trc_ini_state 
     198      !!---------------------------------------------------------------------- 
     199      !!                     ***  ROUTINE trc_ini_state *** 
     200      !! ** Purpose :          Initialisation of passive tracer concentration  
     201      !!---------------------------------------------------------------------- 
     202      USE zpshde          ! partial step: hor. derivative   (zps_hde routine) 
     203      USE trcrst          ! passive tracers restart 
     204      USE trcdta          ! initialisation from files 
     205      ! 
     206      INTEGER ::   jk, jn, jl    ! dummy loop indices 
     207      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta   ! 4D  workspace 
     208      !!---------------------------------------------------------------------- 
     209      ! 
    112210      IF( ln_trcdta )      CALL trc_dta_init(jptra) 
    113  
    114211 
    115212      IF( ln_rsttr ) THEN 
     
    146243  
    147244      tra(:,:,:,:) = 0._wp 
    148       IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav )   &              ! Partial steps: before horizontal gradient of passive 
    149         &    CALL zps_hde    ( nit000, jptra, trn, gtru, gtrv  )  ! Partial steps: before horizontal gradient 
    150       IF( ln_zps .AND. .NOT. lk_c1d .AND.       ln_isfcav )   & 
    151         &    CALL zps_hde_isf( nit000, jptra, trn, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi )       ! tracers at the bottom ocean level 
    152  
    153  
    154       ! 
    155       IF( nn_dttrc /= 1 )        CALL trc_sub_ini      ! Initialize variables for substepping passive tracers 
    156       ! 
    157  
    158       trai(:) = 0._wp                                                   ! initial content of all tracers 
    159       DO jn = 1, jptra 
    160          trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   ) 
    161       END DO 
    162  
    163       IF(lwp) THEN               ! control print 
    164          WRITE(numout,*) 
    165          WRITE(numout,*) 
    166          WRITE(numout,*) '          *** Total number of passive tracer jptra = ', jptra 
    167          WRITE(numout,*) '          *** Total volume of ocean                = ', areatot 
    168          WRITE(numout,*) '          *** Total inital content of all tracers ' 
    169          WRITE(numout,*) 
    170          DO jn = 1, jptra 
    171             WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn) 
    172          ENDDO 
    173          WRITE(numout,*) 
    174       ENDIF 
    175       IF(lwp) WRITE(numout,*) 
    176       IF(ln_ctl) THEN            ! print mean trends (used for debugging) 
    177          CALL prt_ctl_trc_init 
    178          WRITE(charout, FMT="('ini ')") 
    179          CALL prt_ctl_trc_info( charout ) 
    180          CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 
    181       ENDIF 
    182 9000  FORMAT(' tracer nb : ',i2,'      name :',a10,'      initial content :',e18.10) 
    183       ! 
    184       IF( nn_timing == 1 )   CALL timing_stop('trc_init') 
    185       ! 
    186    END SUBROUTINE trc_init 
     245      !                                                         ! Partial top/bottom cell: GRADh(trn) 
     246   END SUBROUTINE trc_ini_state 
    187247 
    188248 
Note: See TracChangeset for help on using the changeset viewer.