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 11134 for branches/UKMO/r6232_collate_bgc_diagnostics/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90 – NEMO

Ignore:
Timestamp:
2019-06-18T17:48:39+02:00 (5 years ago)
Author:
jcastill
Message:

Full set of changes as in the original branch

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/r6232_collate_bgc_diagnostics/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90

    r11132 r11134  
    1818   USE trdtra 
    1919   USE prtctl_trc          ! Print control for debbuging 
     20#if defined key_tracer_budget 
     21   USE iom 
     22#endif 
    2023 
    2124   IMPLICIT NONE 
     
    5154      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index       
    5255      CHARACTER (len=22) :: charout 
     56      ! +++>>> FABM 
     57      INTEGER :: jn 
     58      ! FABM <<<+++ 
    5359      !!---------------------------------------------------------------------- 
    5460      ! 
     
    6571      IF( lk_pisces  )   CALL trc_rad_sms( kt, trb, trn, jp_pcs0 , jp_pcs1, cpreserv='Y' )  ! PISCES model 
    6672      IF( lk_my_trc  )   CALL trc_rad_sms( kt, trb, trn, jp_myt0 , jp_myt1               )  ! MY_TRC model 
    67  
     73      ! +++>>> FABM 
     74      IF( lk_fabm  )   THEN 
     75        DO jn=1,jp_fabm ! state variable loop 
     76          IF (lk_rad_fabm(jn)) THEN 
     77           CALL trc_rad_sms( kt, trb, trn, jn+jp_fabm_m1 , jn+jp_fabm_m1 ) 
     78          ENDIF 
     79        END DO 
     80      END IF 
     81      ! FABM <<<+++ 
    6882      ! 
    6983      IF(ln_ctl) THEN      ! print mean trends (used for debugging) 
     
    110124      REAL(wp) :: zcoef, ztrcorn, ztrmasn   !    "         " 
    111125      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrtrdb, ztrtrdn   ! workspace arrays 
     126#if defined key_tracer_budget 
     127      REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  ztrtrdb_m1 ! slwa  
     128#endif 
    112129      REAL(wp) :: zs2rdt 
    113130      LOGICAL ::   lldebug = .FALSE. 
     
    116133  
    117134      IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrtrdb, ztrtrdn ) 
     135#if defined key_tracer_budget 
     136      IF( kt == nittrc000 .AND. l_trdtrc) THEN 
     137         IF (.not. ALLOCATED(ztrtrdb_m1)) ALLOCATE( ztrtrdb_m1(jpi,jpj,jpk,jptra) )  ! slwa 
     138            DO jn = jp_sms0, jp_sms1 
     139               IF( ln_rsttr .AND.    &                     ! Restart: read in restart  file 
     140                  iom_varid( numrtr, 'rdb_trend_'//TRIM(ctrcnm(jn)), ldstop = .FALSE. ) > 0 ) THEN 
     141                  IF(lwp) WRITE(numout,*) '          nittrc000-nn_dttrc RDB tracer trend read for',TRIM(ctrcnm(jn)) 
     142                  CALL iom_get( numrtr, jpdom_autoglo, 'rdb_trend_'//TRIM(ctrcnm(jn)), ztrtrdb_m1(:,:,:,jn) )   ! before tracer trend for rdb 
     143               ELSE 
     144                  IF(lwp) WRITE(numout,*) '          no nittrc000-nn_dttrc RDB tracer trend for',TRIM(ctrcnm(jn)),', setting to 0.' 
     145                  ztrtrdb_m1(:,:,:,jn)=0.0 
     146               ENDIF 
     147            END DO 
     148      ENDIF 
     149#endif 
    118150       
    119151      IF( PRESENT( cpreserv )  ) THEN   !  total tracer concentration is preserved  
     
    156188               ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 
    157189               ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt  
     190#if defined key_tracer_budget 
     191! slwa budget code 
     192               DO jk = 1, jpkm1 
     193                  ztrtrdb(:,:,jk) = ztrtrdb(:,:,jk) * e1t(:,:) * e2t(:,:) * fse3t(:,:,jk) 
     194                  ztrtrdn(:,:,jk) = ztrtrdn(:,:,jk) * e1t(:,:) * e2t(:,:) * fse3t(:,:,jk) 
     195               END DO 
     196               CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb_m1(:,:,:,jn) ) 
     197               ztrtrdb_m1(:,:,:,jn)=ztrtrdb(:,:,:) 
     198#else 
    158199               CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb )       ! Asselin-like trend handling 
     200#endif 
    159201               CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrdn )       ! standard     trend handling 
    160202              ! 
     
    187229               ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 
    188230               ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt  
     231#if defined key_tracer_budget 
     232! slwa budget code 
     233               DO jk = 1, jpkm1 
     234                  ztrtrdb(:,:,jk) = ztrtrdb(:,:,jk) * e1t(:,:) * e2t(:,:) * fse3t(:,:,jk) 
     235                  ztrtrdn(:,:,jk) = ztrtrdn(:,:,jk) * e1t(:,:) * e2t(:,:) * fse3t(:,:,jk) 
     236               END DO 
     237               CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb_m1(:,:,:,jn) ) 
     238               ztrtrdb_m1(:,:,:,jn)=ztrtrdb(:,:,:) 
     239#else 
    189240               CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb )       ! Asselin-like trend handling 
     241#endif 
    190242               CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrdn )       ! standard     trend handling 
    191243              ! 
     
    195247 
    196248      ENDIF 
     249 
     250#if defined key_tracer_budget 
     251      !                                           Write in the tracer restart file 
     252      !                                          ******************************* 
     253      IF( lrst_trc ) THEN 
     254         IF(lwp) WRITE(numout,*) 
     255         IF(lwp) WRITE(numout,*) 'trc : RDB trend at last time step for tracer budget written in tracer restart file ',   & 
     256            &                    'at it= ', kt,' date= ', ndastp 
     257         IF(lwp) WRITE(numout,*) '~~~~' 
     258         DO jn = jp_sms0, jp_sms1 
     259            CALL iom_rstput( kt, nitrst, numrtw, 'rdb_trend_'//TRIM(ctrcnm(jn)), ztrtrdb_m1(:,:,:,jn) ) 
     260         END DO 
     261      ENDIF 
     262#endif 
    197263 
    198264      IF( l_trdtrc )  CALL wrk_dealloc( jpi, jpj, jpk, ztrtrdb, ztrtrdn ) 
Note: See TracChangeset for help on using the changeset viewer.