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/OPA_SRC/DIA/diaptr.F90 – 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

File:
1 edited

Legend:

Unmodified
Added
Removed
  • 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         ! 
Note: See TracChangeset for help on using the changeset viewer.