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 6679 for branches/UKMO/dev_r5518_GC3p0_package_v2/NEMOGCM/NEMO – NEMO

Ignore:
Timestamp:
2016-06-09T18:34:00+02:00 (8 years ago)
Author:
malcolmroberts
Message:

Merged in changes from v3_6_extra_CMIP6_diagnostics up to revision 6674

Location:
branches/UKMO/dev_r5518_GC3p0_package_v2/NEMOGCM/NEMO
Files:
15 edited
2 copied

Legend:

Unmodified
Added
Removed

  • branches/UKMO/dev_r5518_GC3p0_package_v2/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90

    r6462 r6679  
    9595      CALL iom_put( 'voltot', zvol               ) 
    9696      CALL iom_put( 'sshtot', zvolssh / area_tot ) 
     97      CALL iom_put( 'sshdyn', sshn(:,:) - (zvolssh / area_tot) ) 
    9798 
    9899      !                      

  • branches/UKMO/dev_r5518_GC3p0_package_v2/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90

    r6463 r6679  
    2121   USE dom_oce          ! ocean space and time domain 
    2222   USE phycst           ! physical constants 
     23   USE ldftra_oce  
    2324   ! 
    2425   USE iom              ! IOM library 
    … …  
    4142 
    4243   !                                  !!** namelist  namptr  ** 
    43    REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   htr_adv, htr_ldf   !: Heat TRansports (adv, diff, overturn.) 
    44    REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   str_adv, str_ldf   !: Salt TRansports (adv, diff, overturn.) 
    45     
     44   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   htr_adv, htr_ldf, htr_eiv, htr_vt   !: Heat TRansports (adv, diff, Bolus.) 
     45   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   str_adv, str_ldf, str_eiv, str_vs   !: Salt TRansports (adv, diff, Bolus.) 
    4646 
    4747   LOGICAL, PUBLIC ::   ln_diaptr   !  Poleward transport flag (T) or not (F) 
    … …  
    210210              ENDDO 
    211211            ENDIF 
    212  
    213          ENDIF 
     212         ENDIF 
     213 
     214         IF( iom_use("sopht_vt") .OR. iom_use("sopst_vs") ) THEN    
     215            z2d(1,:) = htr_vt(:,1) * rc_pwatt        !  (conversion in PW)  
     216            DO ji = 1, jpi 
     217               z2d(ji,:) = z2d(1,:) 
     218            ENDDO 
     219            cl1 = 'sopht_vt' 
     220            CALL iom_put( TRIM(cl1), z2d ) 
     221            z2d(1,:) = str_vs(:,1) * rc_ggram        !  (conversion in Gg) 
     222            DO ji = 1, jpi 
     223               z2d(ji,:) = z2d(1,:) 
     224            ENDDO 
     225            cl1 = 'sopst_vs' 
     226            CALL iom_put( TRIM(cl1), z2d ) 
     227            IF( ln_subbas ) THEN 
     228              DO jn=2,nptr 
     229               z2d(1,:) = htr_vt(:,jn) * rc_pwatt        !  (conversion in PW) 
     230               DO ji = 1, jpi 
     231                 z2d(ji,:) = z2d(1,:) 
     232               ENDDO 
     233               cl1 = TRIM('sopht_vt_'//clsubb(jn))                  
     234               CALL iom_put( cl1, z2d ) 
     235               z2d(1,:) = str_vs(:,jn) * rc_ggram        ! (conversion in Gg) 
     236               DO ji = 1, jpi 
     237                  z2d(ji,:) = z2d(1,:) 
     238               ENDDO 
     239               cl1 = TRIM('sopst_vs_'//clsubb(jn))                  
     240               CALL iom_put( cl1, z2d )               
     241              ENDDO 
     242            ENDIF 
     243         ENDIF 
     244 
     245#ifdef key_diaeiv 
     246         IF(lk_traldf_eiv) THEN 
     247            IF( iom_use("sophteiv") .OR. iom_use("sopsteiv") ) THEN  
     248               z2d(1,:) = htr_eiv(:,1) * rc_pwatt        !  (conversion in PW)  
     249               DO ji = 1, jpi 
     250                  z2d(ji,:) = z2d(1,:) 
     251               ENDDO 
     252               cl1 = 'sophteiv' 
     253               CALL iom_put( TRIM(cl1), z2d ) 
     254               z2d(1,:) = str_eiv(:,1) * rc_ggram        !  (conversion in Gg) 
     255               DO ji = 1, jpi 
     256                  z2d(ji,:) = z2d(1,:) 
     257               ENDDO 
     258               cl1 = 'sopsteiv' 
     259               CALL iom_put( TRIM(cl1), z2d ) 
     260               IF( ln_subbas ) THEN 
     261                  DO jn=2,nptr 
     262                     z2d(1,:) = htr_eiv(:,jn) * rc_pwatt        !  (conversion in PW) 
     263                     DO ji = 1, jpi 
     264                        z2d(ji,:) = z2d(1,:) 
     265                     ENDDO 
     266                     cl1 = TRIM('sophteiv_'//clsubb(jn))                  
     267                     CALL iom_put( cl1, z2d ) 
     268                     z2d(1,:) = str_eiv(:,jn) * rc_ggram        ! (conversion in Gg) 
     269                     DO ji = 1, jpi 
     270                        z2d(ji,:) = z2d(1,:) 
     271                     ENDDO 
     272                     cl1 = TRIM('sopsteiv_'//clsubb(jn))  
     273                     CALL iom_put( cl1, z2d )               
     274                  ENDDO 
     275               ENDIF 
     276            ENDIF 
     277         ENDIF 
     278#endif 
    214279         ! 
    215280      ENDIF 
    … …  
    292357         htr_adv(:,:) = 0._wp  ;  str_adv(:,:) =  0._wp   
    293358         htr_ldf(:,:) = 0._wp  ;  str_ldf(:,:) =  0._wp  
     359         htr_eiv(:,:) = 0._wp  ;  str_eiv(:,:) =  0._wp  
     360         htr_vt(:,:) = 0._wp  ;   str_vs(:,:) =  0._wp  
    294361         ! 
    295362      ENDIF  
    … …  
    305372      !!---------------------------------------------------------------------- 
    306373      INTEGER                         , INTENT(in )  :: ktra  ! tracer index 
    307       CHARACTER(len=3)                , INTENT(in)   :: cptr  ! transport type  'adv'/'ldf' 
     374      CHARACTER(len=3)                , INTENT(in)   :: cptr  ! transport type  'adv'/'ldf'/'eiv' 
    308375      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in)   :: pva   ! 3D input array of advection/diffusion 
    309376      INTEGER                                        :: jn    ! 
    … …  
    318385         IF( ktra == jp_sal )  str_ldf(:,1) = ptr_sj( pva(:,:,:) ) 
    319386      ENDIF 
     387      IF( cptr == 'eiv' ) THEN 
     388         IF( ktra == jp_tem )  htr_eiv(:,1) = ptr_sj( pva(:,:,:) ) 
     389         IF( ktra == jp_sal )  str_eiv(:,1) = ptr_sj( pva(:,:,:) ) 
     390      ENDIF 
     391      IF( cptr == 'vts' ) THEN 
     392         IF( ktra == jp_tem )  htr_vt(:,1) = ptr_sj( pva(:,:,:) ) 
     393         IF( ktra == jp_sal )  str_vs(:,1) = ptr_sj( pva(:,:,:) ) 
     394      ENDIF 
    320395      ! 
    321396      IF( ln_subbas ) THEN 
    … …  
    345420             ENDIF 
    346421         ENDIF 
     422         IF( cptr == 'eiv' ) THEN 
     423             IF( ktra == jp_tem ) THEN  
     424                DO jn = 2, nptr 
     425                    htr_eiv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     426                 END DO 
     427             ENDIF 
     428             IF( ktra == jp_sal ) THEN  
     429                DO jn = 2, nptr 
     430                   str_eiv(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     431                END DO 
     432             ENDIF 
     433         ENDIF 
     434         IF( cptr == 'vts' ) THEN 
     435             IF( ktra == jp_tem ) THEN  
     436                DO jn = 2, nptr 
     437                    htr_vt(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     438                 END DO 
     439             ENDIF 
     440             IF( ktra == jp_sal ) THEN  
     441                DO jn = 2, nptr 
     442                   str_vs(:,jn) = ptr_sj( pva(:,:,:), btmsk(:,:,jn) ) 
     443                END DO 
     444             ENDIF 
     445         ENDIF 
    347446         ! 
    348447      ENDIF 
    … …  
    362461      ALLOCATE( btmsk(jpi,jpj,nptr) ,           & 
    363462         &      htr_adv(jpj,nptr) , str_adv(jpj,nptr) ,   & 
     463         &      htr_eiv(jpj,nptr) , str_eiv(jpj,nptr) ,   & 
     464         &      htr_vt(jpj,nptr)  , str_vs(jpj,nptr)  ,   & 
    364465         &      htr_ldf(jpj,nptr) , str_ldf(jpj,nptr) , STAT=ierr(1)  ) 
    365466         ! 

  • branches/UKMO/dev_r5518_GC3p0_package_v2/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r6462 r6679  
    308308      ENDIF 
    309309          
    310       IF( iom_use("u_masstr") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN 
     310      IF( iom_use("u_masstr") .OR. iom_use("u_masstr_vint") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN 
    311311         z3d(:,:,jpk) = 0.e0 
     312         z2d(:,:) = 0.e0 
    312313         DO jk = 1, jpkm1 
    313314            z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) * umask(:,:,jk) 
     315            z2d(:,:) = z2d(:,:) + z3d(:,:,jk) 
    314316         END DO 
    315317         CALL iom_put( "u_masstr", z3d )                  ! mass transport in i-direction 
     318         CALL iom_put( "u_masstr_vint", z2d )             ! mass transport in i-direction vertical sum 
    316319      ENDIF 
    317320       
    … …  
    376379         CALL iom_put( "v_salttr", 0.5 * z2d )            !  heat transport in j-direction 
    377380      ENDIF 
     381 
     382      CALL iom_put( "bn2", rn2 )  !Brunt-Vaisala buoyancy frequency (N^2) 
    378383      ! 
    379384      CALL wrk_dealloc( jpi , jpj      , z2d ) 

  • branches/UKMO/dev_r5518_GC3p0_package_v2/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r6462 r6679  
    193193      ! automatic definitions of some of the xml attributs 
    194194      CALL set_xmlatt 
     195 
     196      CALL set_1point 
    195197 
    196198      ! end file definition 
    … …  
    14571459 
    14581460   END SUBROUTINE set_scalar 
     1461 
     1462   SUBROUTINE set_1point 
     1463      !!---------------------------------------------------------------------- 
     1464      !!                     ***  ROUTINE set_1point  *** 
     1465      !! 
     1466      !! ** Purpose :   define zoom grid for scalar fields 
     1467      !! 
     1468      !!---------------------------------------------------------------------- 
     1469      REAL(wp), DIMENSION(1)   ::   zz = 1. 
     1470      INTEGER  :: ix, iy 
     1471      !!---------------------------------------------------------------------- 
     1472      CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  Nearest point to north pole should be ocean 
     1473      CALL iom_set_domain_attr('1point', zoom_ibegin=ix, zoom_jbegin=iy) 
     1474 
     1475   END SUBROUTINE set_1point 
    14591476 
    14601477 

  • branches/UKMO/dev_r5518_GC3p0_package_v2/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r6462 r6679  
    14051405         zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 
    14061406         zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 
    1407             CALL iom_put( 'rain'         , frcv(jpr_rain)%z3(:,:,1)              )   ! liquid precipitation  
     1407         CALL iom_put( 'rain'         , frcv(jpr_rain)%z3(:,:,1) * tmask(:,:,1)      )   ! liquid precipitation  
     1408         CALL iom_put( 'rain_ao_cea'  , frcv(jpr_rain)%z3(:,:,1)* p_frld(:,:) * tmask(:,:,1)      )   ! liquid precipitation  
    14081409         IF( iom_use('hflx_rain_cea') )   & 
    1409             CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) )   ! heat flux from liq. precip.  
     1410            CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) * tmask(:,:,1))   ! heat flux from liq. precip.  
    14101411         IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') )   & 
    14111412            ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 
    14121413         IF( iom_use('evap_ao_cea'  ) )   & 
    1413             CALL iom_put( 'evap_ao_cea'  , ztmp                   )   ! ice-free oce evap (cell average) 
     1414            CALL iom_put( 'evap_ao_cea'  , ztmp * tmask(:,:,1)                  )   ! ice-free oce evap (cell average) 
    14141415         IF( iom_use('hflx_evap_cea') )   & 
    1415             CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) )   ! heat flux from from evap (cell average) 
     1416            CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) * tmask(:,:,1) )   ! heat flux from from evap (cell average) 
    14161417      CASE( 'oce and ice'   )   ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 
    14171418         zemp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) 
    … …  
    14211422      END SELECT 
    14221423 
     1424#if defined key_lim3 
     1425      ! zsnw = snow percentage over ice after wind blowing 
     1426      zsnw(:,:) = 0._wp 
     1427      CALL lim_thd_snwblow( p_frld, zsnw ) 
     1428      
     1429      ! --- evaporation (kg/m2/s) --- ! 
     1430      zevap_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) 
     1431      ! since the sensitivity of evap to temperature (devap/dT) is not prescribed by the atmosphere, we set it to 0 
     1432      ! therefore, sublimation is not redistributed over the ice categories in case no subgrid scale fluxes are provided by atm. 
     1433      zdevap_ice(:,:) = 0._wp 
     1434      
     1435      ! --- evaporation minus precipitation corrected for the effect of wind blowing on snow --- ! 
     1436      zemp_oce(:,:) = zemp_tot(:,:) - zemp_ice(:,:) - zsprecip * (1._wp - zsnw) 
     1437      zemp_ice(:,:) = zemp_ice(:,:) + zsprecip * (1._wp - zsnw)  
     1438         
     1439      ! Sublimation over sea-ice (cell average) 
    14231440      IF( iom_use('subl_ai_cea') )   & 
    1424          CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) )   ! Sublimation over sea-ice         (cell average) 
    1425       !    
    1426       !                                                           ! runoffs and calving (put in emp_tot) 
     1441         CALL iom_put( 'subl_ai_cea', zevap_ice(:,:) * zicefr(:,:) ) 
     1442 
     1443      ! runoffs and calving (put in emp_tot) 
    14271444      IF( srcv(jpr_rnf)%laction )   rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 
     1445      IF( srcv(jpr_cal)%laction ) THEN  
     1446         zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 
     1447         CALL iom_put( 'calving_cea', frcv(jpr_cal)%z3(:,:,1) ) 
     1448      ENDIF 
     1449 
     1450      IF( ln_mixcpl ) THEN 
     1451         emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:) 
     1452         emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:) 
     1453         emp_oce(:,:) = emp_oce(:,:) * xcplmask(:,:,0) + zemp_oce(:,:) * zmsk(:,:) 
     1454         sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:) 
     1455         tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:) 
     1456      ELSE 
     1457         DO jl=1,jpl 
     1458            evap_ice (:,:,jl) = evap_ice (:,:,jl) * xcplmask(:,:,0) + zevap_ice (:,:) * zmsk(:,:) 
     1459            devap_ice(:,:,jl) = devap_ice(:,:,jl) * xcplmask(:,:,0) + zdevap_ice(:,:) * zmsk(:,:) 
     1460         ENDDO 
     1461      ELSE 
     1462         emp_tot(:,:) =         zemp_tot(:,:) 
     1463         emp_ice(:,:) =         zemp_ice(:,:) 
     1464         emp_oce(:,:) =         zemp_oce(:,:)      
     1465         sprecip(:,:) =         zsprecip(:,:) 
     1466         tprecip(:,:) =         ztprecip(:,:) 
     1467         DO jl=1,jpl 
     1468            evap_ice (:,:,jl) = zevap_ice (:,:) 
     1469            devap_ice(:,:,jl) = zdevap_ice(:,:) 
     1470         ENDDO 
     1471      ENDIF 
     1472 
     1473                                     CALL iom_put( 'snowpre'    , sprecip                         )  ! Snow 
     1474      IF( iom_use('snow_ao_cea') )   CALL iom_put( 'snow_ao_cea', sprecip(:,:) * ( 1._wp - zsnw ) )  ! Snow over ice-free ocean  (cell average) 
     1475      IF( iom_use('snow_ai_cea') )   CALL iom_put( 'snow_ai_cea', sprecip(:,:) *           zsnw   )  ! Snow over sea-ice         (cell average)     
     1476#else 
     1477      ! Sublimation over sea-ice (cell average) 
     1478      IF( iom_use('subl_ai_cea') )  CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) 
     1479      ! runoffs and calving (put in emp_tot) 
     1480      IF( srcv(jpr_rnf)%laction )   rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 
     1481      IF( iom_use('hflx_rnf_cea') )   & 
     1482         CALL iom_put( 'hflx_rnf_cea' , rnf(:,:) * zcptn(:,:) ) 
    14281483      IF( srcv(jpr_cal)%laction ) THEN  
    14291484         zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 
    … …  
    14431498      ENDIF 
    14441499 
    1445          CALL iom_put( 'snowpre'    , sprecip                                )   ! Snow 
     1500         CALL iom_put( 'snowpre'    , sprecip * tmask(:,:,1)                 )   ! Snow 
    14461501      IF( iom_use('snow_ao_cea') )   & 
    1447          CALL iom_put( 'snow_ao_cea', sprecip(:,:) * p_frld(:,:)             )   ! Snow        over ice-free ocean  (cell average) 
     1502         CALL iom_put( 'snow_ao_cea', sprecip(:,:) * p_frld(:,:) * tmask(:,:,1)       )   ! Snow        over ice-free ocean  (cell average) 
    14481503      IF( iom_use('snow_ai_cea') )   & 
    1449          CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:)             )   ! Snow        over sea-ice         (cell average) 
    1450  
     1504         CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:) * tmask(:,:,1)       )   ! Snow        over sea-ice         (cell average) 
     1505#endif 
    14511506      !                                                      ! ========================= ! 
    14521507      SELECT CASE( TRIM( sn_rcv_qns%cldes ) )                !   non solar heat fluxes   !   (qns) 

  • branches/UKMO/dev_r5518_GC3p0_package_v2/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90

    r6462 r6679  
    2828   USE wrk_nemo        ! Memory Allocation 
    2929   USE timing          ! Timing 
     30   USE diaptr         ! Heat/Salt transport diagnostics 
    3031 
    3132   IMPLICIT NONE 
    … …  
    7879# endif   
    7980      REAL(wp), POINTER, DIMENSION(:,:) :: zu_eiv, zv_eiv, zw_eiv, z2d 
     81      REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d 
    8082      !!---------------------------------------------------------------------- 
    8183      ! 
    … …  
    8486# if defined key_diaeiv  
    8587      CALL wrk_alloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv, z2d ) 
     88      IF( ln_diaptr ) CALL wrk_alloc( jpi, jpj, jpk, z3d ) 
    8689# else 
    8790      CALL wrk_alloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv ) 
    … …  
    160163         CALL iom_put( "voce_eiv", v_eiv )    ! j-eiv current 
    161164         CALL iom_put( "woce_eiv", w_eiv )    ! vert. eiv current 
     165         IF( iom_use('weiv_masstr') ) THEN   ! vertical mass transport & its square value 
     166           z2d(:,:) = rau0 * e12t(:,:) 
     167           DO jk = 1, jpk 
     168              z3d(:,:,jk) = w_eiv(:,:,jk) * z2d(:,:) 
     169           END DO 
     170           CALL iom_put( "weiv_masstr" , z3d )   
     171         ENDIF 
     172         IF( iom_use("ueiv_masstr") .OR. iom_use("ueiv_heattr") ) THEN 
     173            z3d(:,:,jpk) = 0.e0 
     174            z2d(:,:) = 0.e0 
     175            DO jk = 1, jpkm1 
     176               z3d(:,:,jk) = rau0 * un(:,:,jk) * e2u(:,:) * fse3u(:,:,jk) * umask(:,:,jk) 
     177               z2d(:,:) = z2d(:,:) + z3d(:,:,jk) 
     178            END DO 
     179            CALL iom_put( "ueiv_masstr", z3d )                  ! mass transport in i-direction 
     180         ENDIF 
     181 
    162182         IF( iom_use('ueiv_heattr') ) THEN 
    163183            zztmp = 0.5 * rau0 * rcp  
    … …  
    166186               DO jj = 2, jpjm1 
    167187                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    168                      z2d(ji,jj) = z2d(ji,jj) + u_eiv(ji,jj,jk) & 
    169                        &         * (tsn(ji,jj,jk,jp_tem)+tsn(ji+1,jj,jk,jp_tem)) * e2u(ji,jj) * fse3u(ji,jj,jk)  
     188                     z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
    170189                  END DO 
    171190               END DO 
    … …  
    174193            CALL iom_put( "ueiv_heattr", zztmp * z2d )                  ! heat transport in i-direction 
    175194         ENDIF 
     195 
     196         IF( iom_use("veiv_masstr") .OR. iom_use("veiv_heattr") ) THEN 
     197            z3d(:,:,jpk) = 0.e0 
     198            z2d(:,:) = 0.e0 
     199            DO jk = 1, jpkm1 
     200               z3d(:,:,jk) = rau0 * vn(:,:,jk) * e1v(:,:) * fse3v(:,:,jk) * vmask(:,:,jk) 
     201            END DO 
     202            CALL iom_put( "veiv_masstr", z3d )                  ! mass transport in j-direction 
     203         ENDIF 
    176204             
    177205         IF( iom_use('veiv_heattr') ) THEN 
    178             zztmp = 0.5 * rau0 * rcp  
    179206            z2d(:,:) = 0.e0  
    180207            DO jk = 1, jpkm1 
    181208               DO jj = 2, jpjm1 
    182209                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    183                      z2d(ji,jj) = z2d(ji,jj) + v_eiv(ji,jj,jk) & 
    184                      &           * (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) * e1v(ji,jj) * fse3v(ji,jj,jk)  
     210                     z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 
    185211                  END DO 
    186212               END DO 
    … …  
    190216         ENDIF 
    191217    END IF 
     218! 
     219    IF( ln_diaptr .AND. cdtype == 'TRA' ) THEN 
     220       z3d(:,:,:) = 0._wp 
     221       DO jk = 1, jpkm1 
     222          DO jj = 2, jpjm1 
     223             DO ji = fs_2, fs_jpim1   ! vector opt. 
     224                z3d(ji,jj,jk) = v_eiv(ji,jj,jk) * 0.5 * (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) & 
     225                &             * e1v(ji,jj) * fse3v(ji,jj,jk) 
     226             END DO 
     227          END DO 
     228       END DO 
     229       CALL dia_ptr_ohst_components( jp_tem, 'eiv', z3d ) 
     230       z3d(:,:,:) = 0._wp 
     231       DO jk = 1, jpkm1 
     232          DO jj = 2, jpjm1 
     233             DO ji = fs_2, fs_jpim1   ! vector opt. 
     234                z3d(ji,jj,jk) = v_eiv(ji,jj,jk) * 0.5 * (tsn(ji,jj,jk,jp_sal)+tsn(ji,jj+1,jk,jp_sal)) & 
     235                &             * e1v(ji,jj) * fse3v(ji,jj,jk) 
     236             END DO 
     237          END DO 
     238       END DO 
     239       CALL dia_ptr_ohst_components( jp_sal, 'eiv', z3d ) 
     240    ENDIF 
    192241# endif   
    193       !  
     242 
    194243# if defined key_diaeiv  
    195244      CALL wrk_dealloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv, z2d ) 
     245      IF( ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, z3d ) 
    196246# else 
    197247      CALL wrk_dealloc( jpi, jpj, zu_eiv, zv_eiv, zw_eiv ) 

  • branches/UKMO/dev_r5518_GC3p0_package_v2/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90

    r6463 r6679  
    3434   USE timing         ! Timing 
    3535   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     36   USE iom 
    3637 
    3738   IMPLICIT NONE 
    … …  
    4243 
    4344   LOGICAL ::   l_trd   ! flag to compute trends 
     45   LOGICAL ::   l_trans   ! flag to output vertically integrated transports 
    4446 
    4547   !! * Substitutions 
    … …  
    8587      REAL(wp) ::   zfm_ui, zfm_vj, zfm_wk   !   -      - 
    8688      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwz 
    87       REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz 
    88       REAL(wp), POINTER, DIMENSION(:,:,:) :: zptry 
     89      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz, z2d, zptry 
     90      REAL(wp), POINTER, DIMENSION(:,:)   :: z2d 
    8991      !!---------------------------------------------------------------------- 
    9092      ! 
    … …  
    99101         ! 
    100102         l_trd = .FALSE. 
     103         l_trans = .FALSE. 
    101104         IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 
     105         IF( cdtype == 'TRA' .AND. (iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") ) ) l_trans = .TRUE. 
    102106      ENDIF 
    103107      ! 
    104       IF( l_trd )  THEN 
     108      IF( l_trd .OR. l_trans )  THEN 
    105109         CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
    106110         ztrdx(:,:,:) = 0.e0   ;    ztrdy(:,:,:) = 0.e0   ;   ztrdz(:,:,:) = 0.e0 
     111         CALL wrk_alloc( jpi, jpj, z2d ) 
    107112      ENDIF 
    108113      ! 
    … …  
    194199 
    195200         !                                 ! trend diagnostics (contribution of upstream fluxes) 
    196          IF( l_trd )  THEN  
     201         IF( l_trd .OR. l_trans )  THEN  
    197202            ! store intermediate advective trends 
    198203            ztrdx(:,:,:) = zwx(:,:,:)   ;    ztrdy(:,:,:) = zwy(:,:,:)  ;   ztrdz(:,:,:) = zwz(:,:,:) 
    … …  
    257262 
    258263         !                                 ! trend diagnostics (contribution of upstream fluxes) 
    259          IF( l_trd )  THEN  
     264         IF( l_trd .OR. l_trans )  THEN  
    260265            ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:)  ! <<< Add to previously computed 
    261266            ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed 
    262267            ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:)  ! <<< Add to previously computed 
    263              
    264             CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) )    
    265             CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) )   
    266             CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) )  
     268         ENDIF 
     269          
     270         IF( l_trd ) THEN  
     271            CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 
     272            CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 
     273            CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 
    267274         END IF 
    268          !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
     275 
     276         IF( l_trans .AND. jn==jp_tem ) THEN 
     277            z2d(:,:) = 0._wp  
     278            DO jk = 1, jpkm1 
     279               DO jj = 2, jpjm1 
     280                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     281                     z2d(ji,jj) = z2d(ji,jj) + ztrdx(ji,jj,jk)  
     282                  END DO 
     283               END DO 
     284            END DO 
     285            CALL lbc_lnk( z2d, 'U', -1. ) 
     286            CALL iom_put( "uadv_heattr", rau0_rcp * z2d )       ! heat transport in i-direction 
     287              ! 
     288            z2d(:,:) = 0._wp  
     289            DO jk = 1, jpkm1 
     290               DO jj = 2, jpjm1 
     291                  DO ji = fs_2, fs_jpim1   ! vector opt. 
     292                     z2d(ji,jj) = z2d(ji,jj) + ztrdy(ji,jj,jk)  
     293                  END DO 
     294               END DO 
     295            END DO 
     296            CALL lbc_lnk( z2d, 'V', -1. ) 
     297            CALL iom_put( "vadv_heattr", rau0_rcp * z2d )       ! heat transport in j-direction 
     298         ENDIF 
     299         ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    269300         IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN   
    270301            zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:)  ! <<< Add to previously computed 
    … …  
    274305      END DO 
    275306      ! 
    276                    CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz ) 
    277       IF( l_trd )  CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
     307      CALL wrk_dealloc( jpi, jpj, jpk, zwi, zwz ) 
     308      IF( l_trd .OR. l_trans )  THEN  
     309         CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 
     310         CALL wrk_dealloc( jpi, jpj, z2d ) 
     311      ENDIF 
    278312      IF( cdtype == 'TRA' .AND. ln_diaptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 
    279313      ! 

  • branches/UKMO/dev_r5518_GC3p0_package_v2/NEMOGCM/NEMO/OPA_SRC/step.F90

    r6462 r6679  
    231231      IF( lk_diaar5  )      CALL dia_ar5( kstp )         ! ar5 diag 
    232232      IF( lk_diaharm )      CALL dia_harm( kstp )        ! Tidal harmonic analysis 
     233                            CALL dia_prod( kstp )        ! ocean model: product diagnostics 
    233234                            CALL dia_wri( kstp )         ! ocean model: outputs 
    234235      ! 

  • branches/UKMO/dev_r5518_GC3p0_package_v2/NEMOGCM/NEMO/TOP_SRC/MY_TRC/par_my_trc.F90

    r6462 r6679  
    2525   USE par_c14b   , ONLY : jp_c14b_trd     !: number of tracers in C14 
    2626 
     27   USE par_age   , ONLY : jp_age         !: number of tracers in AGE 
     28   USE par_age   , ONLY : jp_age_2d      !: number of tracers in AGE 
     29   USE par_age   , ONLY : jp_age_3d      !: number of tracers in AGE 
     30   USE par_age   , ONLY : jp_age_trd     !: number of tracers in AGE 
     31 
    2732   IMPLICIT NONE 
    2833 
    29    INTEGER, PARAMETER ::   jp_lm      =  jp_pisces     + jp_cfc     + jp_c14b     !:  
    30    INTEGER, PARAMETER ::   jp_lm_2d   =  jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d  !: 
    31    INTEGER, PARAMETER ::   jp_lm_3d   =  jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d  !: 
    32    INTEGER, PARAMETER ::   jp_lm_trd  =  jp_pisces_trd + jp_cfc_trd + jp_c14b_trd !: 
     34   INTEGER, PARAMETER ::   jp_lm      =  jp_pisces     + jp_cfc     + jp_c14b     + jp_age      !:  
     35   INTEGER, PARAMETER ::   jp_lm_2d   =  jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d  + jp_age_2d   !: 
     36   INTEGER, PARAMETER ::   jp_lm_3d   =  jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d  + jp_age_3d   !: 
     37   INTEGER, PARAMETER ::   jp_lm_trd  =  jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_age_trd  !: 
    3338 
    3439#if defined key_my_trc 

  • branches/UKMO/dev_r5518_GC3p0_package_v2/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90

    r6462 r6679  
    6161      ENDIF 
    6262 
     63      IF( lk_age     )   CALL trc_rad_sms( kt, trb, trn, jp_age0 , jp_age1               )  ! AGE tracer 
    6364      IF( lk_cfc     )   CALL trc_rad_sms( kt, trb, trn, jp_cfc0 , jp_cfc1               )  ! CFC model 
    6465      IF( lk_c14b    )   CALL trc_rad_sms( kt, trb, trn, jp_c14b0, jp_c14b1              )  ! bomb C14 

  • branches/UKMO/dev_r5518_GC3p0_package_v2/NEMOGCM/NEMO/TOP_SRC/par_trc.F90

    r6462 r6679  
    1414   USE par_c14b      ! C14 bomb tracer 
    1515   USE par_cfc       ! CFC 11 and 12 tracers 
     16   USE par_age       ! AGE  tracer 
    1617   USE par_my_trc    ! user defined passive tracers 
    1718 
    … …  
    2425   ! Passive tracers : Total size 
    2526   ! ---------------               ! total number of passive tracers, of 2d and 3d output and trend arrays 
    26    INTEGER, PUBLIC,  PARAMETER ::   jptra    =  jp_pisces     + jp_cfc     + jp_c14b    + jp_my_trc 
    27    INTEGER, PUBLIC,  PARAMETER ::   jpdia2d  =  jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d + jp_my_trc_2d 
    28    INTEGER, PUBLIC,  PARAMETER ::   jpdia3d  =  jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d + jp_my_trc_3d 
     27   INTEGER, PUBLIC,  PARAMETER ::   jptra    =  jp_pisces     + jp_cfc     + jp_c14b    + jp_age    + jp_my_trc 
     28   INTEGER, PUBLIC,  PARAMETER ::   jpdia2d  =  jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d + jp_age_2d + jp_my_trc_2d 
     29   INTEGER, PUBLIC,  PARAMETER ::   jpdia3d  =  jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d + jp_age_3d + jp_my_trc_3d 
    2930   !                     ! total number of sms diagnostic arrays 
    30    INTEGER, PUBLIC,  PARAMETER ::   jpdiabio =  jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_my_trc_trd 
     31   INTEGER, PUBLIC,  PARAMETER ::   jpdiabio =  jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_age_trd + jp_my_trc_trd 
    3132    
    3233   !  1D configuration ("key_c1d") 

  • branches/UKMO/dev_r5518_GC3p0_package_v2/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r6462 r6679  
    2323   USE trcini_pisces   ! PISCES   initialisation 
    2424   USE trcini_c14b     ! C14 bomb initialisation 
     25   USE trcini_age      ! AGE      initialisation 
    2526   USE trcini_my_trc   ! MY_TRC   initialisation 
    2627   USE trcdta          ! initialisation from files 
    … …  
    9899 
    99100      IF( lk_pisces  )       CALL trc_ini_pisces       ! PISCES  bio-model 
    100       IF( lk_cfc     )       CALL trc_ini_cfc          ! CFC     tracers 
     101      IF( lk_cfc     )       CALL trc_ini_cfc          ! CFC       tracers 
    101102      IF( lk_c14b    )       CALL trc_ini_c14b         ! C14 bomb  tracer 
    102       IF( lk_my_trc  )       CALL trc_ini_my_trc       ! MY_TRC  tracers 
     103      IF( lk_age     )       CALL trc_ini_age          ! AGE       tracer 
     104      IF( lk_my_trc  )       CALL trc_ini_my_trc       ! MY_TRC    tracers 
    103105 
    104106      CALL trc_ice_ini                                 ! Tracers in sea ice 

  • branches/UKMO/dev_r5518_GC3p0_package_v2/NEMOGCM/NEMO/TOP_SRC/trcnam.F90

    r6462 r6679  
    2424   USE trcnam_cfc        ! CFC SMS namelist 
    2525   USE trcnam_c14b       ! C14 SMS namelist 
     26   USE trcnam_age        ! AGE SMS namelist 
    2627   USE trcnam_my_trc     ! MY_TRC SMS namelist 
    2728   USE trd_oce        
    … …  
    6162       
    6263      !                                        !  passive tracer informations 
    63       CALL trc_nam_trc 
     64                             CALL trc_nam_trc 
    6465       
    6566      !                                        !   Parameters of additional diagnostics 
    66       CALL trc_nam_dia 
     67      IF( .NOT. lk_iomput)   CALL trc_nam_dia 
    6768 
    6869      !                                        !   namelist of transport 
    69       CALL trc_nam_trp 
     70                             CALL trc_nam_trp 
    7071 
    7172 
    … …  
    161162      ENDIF 
    162163 
    163       IF( lk_c14b     ) THEN   ;   CALL trc_nam_c14b         ! C14 bomb     tracers 
    164       ELSE                    ;   IF(lwp) WRITE(numout,*) '          C14 not used' 
    165       ENDIF 
    166  
    167       IF( lk_my_trc  ) THEN   ;   CALL trc_nam_my_trc      ! MY_TRC  tracers 
    168       ELSE                    ;   IF(lwp) WRITE(numout,*) '          MY_TRC not used' 
     164      IF( lk_c14b    ) THEN  ;   CALL trc_nam_c14b         ! C14 bomb     tracers 
     165      ELSE                   ;   IF(lwp) WRITE(numout,*) '          C14 not used' 
     166      ENDIF 
     167 
     168      IF( lk_age     ) THEN  ;   CALL trc_nam_age         ! AGE     tracer 
     169      ELSE                   ;   IF(lwp) WRITE(numout,*) '          AGE not used' 
     170      ENDIF 
     171 
     172      IF( lk_my_trc  ) THEN  ;   CALL trc_nam_my_trc      ! MY_TRC  tracers 
     173      ELSE                   ;   IF(lwp) WRITE(numout,*) '          MY_TRC not used' 
    169174      ENDIF 
    170175      ! 
    … …  
    359364      ENDIF 
    360365 
    361       IF( ln_diatrc .AND. .NOT. lk_iomput ) THEN  
     366      IF( ln_diatrc ) THEN  
    362367         ALLOCATE( trc2d(jpi,jpj,jpdia2d), trc3d(jpi,jpj,jpk,jpdia3d),  & 
    363368           &       ctrc2d(jpdia2d), ctrc2l(jpdia2d), ctrc2u(jpdia2d) ,  &  
    … …  
    370375      ENDIF 
    371376 
    372       IF( ( ln_diabio .AND. .NOT. lk_iomput ) .OR. l_trdtrc ) THEN 
     377      IF( ln_diabio .OR. l_trdtrc ) THEN 
    373378         ALLOCATE( trbio (jpi,jpj,jpk,jpdiabio) , & 
    374379           &       ctrbio(jpdiabio), ctrbil(jpdiabio), ctrbiu(jpdiabio), STAT = ierr )  

  • branches/UKMO/dev_r5518_GC3p0_package_v2/NEMOGCM/NEMO/TOP_SRC/trcsms.F90

    r6462 r6679  
    1818   USE trcsms_cfc         ! CFC 11 & 12 
    1919   USE trcsms_c14b        ! C14b tracer  
     20   USE trcsms_age         ! AGE tracer  
    2021   USE trcsms_my_trc      ! MY_TRC  tracers 
    2122   USE prtctl_trc         ! Print control for debbuging 
    … …  
    5152      IF( lk_cfc     )   CALL trc_sms_cfc    ( kt )    ! surface fluxes of CFC 
    5253      IF( lk_c14b    )   CALL trc_sms_c14b   ( kt )    ! surface fluxes of C14 
     54      IF( lk_age     )   CALL trc_sms_age    ( kt )    ! AGE tracer 
    5355      IF( lk_my_trc  )   CALL trc_sms_my_trc ( kt )    ! MY_TRC  tracers 
    5456 

  • branches/UKMO/dev_r5518_GC3p0_package_v2/NEMOGCM/NEMO/TOP_SRC/trcwri.F90

    r6462 r6679  
    2020   USE trcwri_cfc 
    2121   USE trcwri_c14b 
     22   USE trcwri_age 
    2223   USE trcwri_my_trc 
    2324 
    … …  
    5960      IF( lk_cfc     )   CALL trc_wri_cfc        ! surface fluxes of CFC 
    6061      IF( lk_c14b    )   CALL trc_wri_c14b       ! surface fluxes of C14 
     62      IF( lk_age     )   CALL trc_wri_age        ! AGE tracer 
    6163      IF( lk_my_trc  )   CALL trc_wri_my_trc     ! MY_TRC  tracers 
    6264      ! 
Note: See TracChangeset for help on using the changeset viewer.