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 3327 – NEMO

Changeset 3327


Ignore:
Timestamp:
2012-03-14T16:09:33+01:00 (12 years ago)
Author:
gm
Message:

Ediag branche: #927 correct a few problems and clean trdtra

Location:
branches/2012/dev_r3309_LOCEAN12_Ediag/NEMOGCM/NEMO/OPA_SRC/TRD
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/2012/dev_r3309_LOCEAN12_Ediag/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90

    r3326 r3327  
    7070      REAL(wp)                  , INTENT(in) ::   pdt            ! time step [s] 
    7171      ! 
     72      INTEGER ::   jk   ! dummy loop indices 
    7273      REAL(wp), POINTER, DIMENSION(:,:)   ::   z2d   ! 2D workspace  
    7374      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zpe   ! 3D workspace  
     
    8788 
    8889      SELECT CASE ( ktrd ) 
    89       CASE ( jptra_xad  )   ;   CALL iom_put( "petrd_xad", zke )   ! zonal    advection 
    90       CASE ( jptra_yad  )   ;   CALL iom_put( "petrd_yad", zke )   ! merid.   advection 
    91       CASE ( jptra_zad  )   ;   CALL iom_put( "petrd_zad", zke )   ! vertical advection 
     90      CASE ( jptra_xad  )   ;   CALL iom_put( "petrd_xad", zpe )   ! zonal    advection 
     91      CASE ( jptra_yad  )   ;   CALL iom_put( "petrd_yad", zpe )   ! merid.   advection 
     92      CASE ( jptra_zad  )   ;   CALL iom_put( "petrd_zad", zpe )   ! vertical advection 
    9293                                IF( .NOT.lk_vvl ) THEN                   ! cst volume : adv flux through z=0 surface 
    9394                                   CALL wrk_alloc( jpi, jpj, z2d ) 
    94                                    z2d(:,:) = wn(:,:,1) * (   drau_dt(:,:,1) * tsn(:,:,1,jp_tem)  
     95                                   z2d(:,:) = wn(:,:,1) * (   drau_dt(:,:,1) * tsn(:,:,1,jp_tem)    & 
    9596                                      &                     + drau_ds(:,:,1) * tsn(:,:,1,jp_sal)  ) / fse3t(:,:,1) 
    9697                                   CALL iom_put( "petrd_sad" , z2d ) 
     
    104105      CASE ( jptra_npc  )   ;   CALL iom_put( "petrd_npc" , zpe )   ! non penetr convect adjustment 
    105106      CASE ( jptra_nsr  )   ;   CALL iom_put( "petrd_for" , zpe )   ! surface forcing + runoff (ln_rnf=T) 
    106       CASE ( jptra_qsr  )   ;   CALL iom_put( "petrd_qsr" , zke )   ! air-sea : penetrative sol radiat 
    107       CASE ( jptra_bbc  )   ;   CALL iom_put( "petrd_bbc", zke )   ! bottom bound cond (geoth flux) 
    108       CASE ( jptra_atf  )   ;   CALL iom_put( "petrd_atf", zke )   ! asselin time filter (last trend) 
     107      CASE ( jptra_qsr  )   ;   CALL iom_put( "petrd_qsr" , zpe )   ! air-sea : penetrative sol radiat 
     108      CASE ( jptra_bbc  )   ;   CALL iom_put( "petrd_bbc" , zpe )   ! bottom bound cond (geoth flux) 
     109      CASE ( jptra_atf  )   ;   CALL iom_put( "petrd_atf" , zpe )   ! asselin time filter (last trend) 
    109110                                IF( .NOT.lk_vvl ) THEN                   ! cst volume : ssh term (otherwise include in e3t variation) 
    110111                                   CALL wrk_alloc( jpi, jpj, z2d ) 
    111                                    z2d(:,:) = ( ssha(:,:) - sshb(:,:) )   & 
    112                                       &     * (   drau_dt(:,:,1) * tsn(:,:,1,jp_tem)  
     112                                   z2d(:,:) = ( ssha(:,:) - sshb(:,:) )                 & 
     113                                      &     * (   drau_dt(:,:,1) * tsn(:,:,1,jp_tem)    & 
    113114                                      &         + drau_ds(:,:,1) * tsn(:,:,1,jp_sal)  ) / ( fse3t(:,:,1) * pdt ) 
    114115                                   CALL iom_put( "petrd_sad" , z2d ) 
     
    141142      IF ( lk_vvl               )   CALL ctl_stop('trd_pen_init : PE trends not coded for variable volume') 
    142143      ! 
    143       r1_2_rau0 = 0.5_wp / rau0 
    144       ! 
    145144   END SUBROUTINE trd_pen_init 
    146145 
    147146   !!====================================================================== 
    148 END MODULE trdtra 
     147END MODULE trdpen 
  • branches/2012/dev_r3309_LOCEAN12_Ediag/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90

    r3326 r3327  
    2020   USE trd_oce        ! trends: ocean variables 
    2121   USE trdmod_trc     ! ocean passive mixed layer tracers trends  
    22    USE trdglo         ! trends:global domain averaged 
     22   USE trdglo         ! trends: global domain averaged 
     23   USE trdpen         ! trends: Potential ENergy 
    2324   USE trdmld         ! ocean active mixed layer tracers trends  
    2425   USE ldftra_oce     ! ocean active tracers lateral physics 
     
    9495      IF( ctype == 'TRA' .AND. ktra == jp_tem ) THEN   !==  Temperature trend  ==! 
    9596         ! 
    96          IF( PRESENT( ptra ) ) THEN                       ! advection: transform flux into trend 
    97             SELECT CASE( ktrd )      
    98             CASE( jptra_xad )   ;   CALL trd_tra_adv( ptrd, pun, ptra, 'X', trdtx )  
    99             CASE( jptra_yad )   ;   CALL trd_tra_adv( ptrd, pun, ptra, 'Y', trdty )  
    100             CASE( jptra_zad )   ;   CALL trd_tra_adv( ptrd, pun, ptra, 'Z', trdt  )  
    101             END SELECT 
    102          ELSE                                             ! other trends: 
     97         SELECT CASE( ktrd ) 
     98         !                            ! advection: transform the advective flux into a trend 
     99         CASE( jptra_xad )   ;   CALL trd_tra_adv( ptrd, pun, ptra, 'X', trdtx )  
     100         CASE( jptra_yad )   ;   CALL trd_tra_adv( ptrd, pun, ptra, 'Y', trdty )  
     101         CASE( jptra_zad )   ;   CALL trd_tra_adv( ptrd, pun, ptra, 'Z', trdt  )  
     102         CASE( jptra_bbc,    &        ! qsr, bbc: on temperature only, send to trd_tra_mng 
     103            &  jptra_qsr )   ;   ztrds(:,:,:) = 0._wp 
     104                                 CALL trd_tra_mng( trdt, ztrds, ktrd, kt ) 
     105         CASE DEFAULT                 ! other trends: masked trends 
    103106            trdt(:,:,:) = ptrd(:,:,:) * tmask(:,:,:)              ! mask & store 
    104             IF( ktrd == jptra_bbc .OR. ktrd == jptra_qsr ) THEN   ! qsr, bbc: on temperature only 
    105                ztrds(:,:,:) = 0._wp 
    106                CALL trd_tra_mng( trdt, ztrds, ktrd, kt )               ! send to trd_tra_mng 
    107             ENDIF 
    108          ENDIF 
     107         END SELECT 
    109108         ! 
    110109      ENDIF 
     
    112111      IF( ctype == 'TRA' .AND. ktra == jp_sal ) THEN      !==  Salinity trends  ==! 
    113112         ! 
    114          IF( PRESENT( ptra ) ) THEN      ! advection: transform the advective flux into a trend 
    115             SELECT CASE( ktrd )          !            and send T & S trends to trd_tra_mng 
    116             CASE( jptra_xad )   ;   CALL trd_tra_adv( ptrd , pun  , ptra, 'X'  , ztrds )  
    117                                     CALL trd_tra_mng( trdtx, ztrds, ktrd, kt   ) 
    118             CASE( jptra_yad )   ;   CALL trd_tra_adv( ptrd , pun  , ptra, 'Y'  , ztrds )  
    119                                 ;   CALL trd_tra_mng( trdty, ztrds, ktrd, kt   ) 
    120             CASE( jptra_zad )   ;   CALL trd_tra_adv( ptrd , pun  , ptra, 'Z'  , ztrds )  
    121                                     CALL trd_tra_mng( trdt , ztrds, ktrd, kt   ) 
    122             END SELECT 
    123          ELSE                            ! other trends: mask and send T & S trends to trd_tra_mng 
     113         SELECT CASE( ktrd ) 
     114         !                            ! advection: transform the advective flux into a trend 
     115         !                            !            and send T & S trends to trd_tra_mng 
     116         CASE( jptra_xad  )   ;   CALL trd_tra_adv( ptrd , pun  , ptra, 'X'  , ztrds )  
     117                                  CALL trd_tra_mng( trdtx, ztrds, ktrd, kt   ) 
     118         CASE( jptra_yad  )   ;   CALL trd_tra_adv( ptrd , pun  , ptra, 'Y'  , ztrds )  
     119                              ;   CALL trd_tra_mng( trdty, ztrds, ktrd, kt   ) 
     120         CASE( jptra_zad  )   ;   CALL trd_tra_adv( ptrd , pun  , ptra, 'Z'  , ztrds )  
     121                                  CALL trd_tra_mng( trdt , ztrds, ktrd, kt   ) 
     122         CASE( jptra_zdfp )           ! diagnose the "PURE" Kz trend (here: just before the swap) 
     123            !                         ! iso-neutral diffusion case otherwise jptra_zdf is "PURE" 
     124            CALL wrk_alloc( jpi, jpj, jpk, zwt, zws, ztrdt ) 
    124125            ! 
    125             IF( ktrd == jptra_zdfp ) THEN     ! diagnose the "PURE" Kz trend (here: just before the swap) 
    126                ! 
    127                IF( ln_traldf_iso ) THEN       ! iso-neutral diffusion only otherwise jptra_zdf is "PURE" 
    128                   ! 
    129                   CALL wrk_alloc( jpi, jpj, jpk, zwt, zws, ztrdt ) 
    130                   ! 
    131                   zwt(:,:, 1 ) = 0._wp   ;   zws(:,:, 1 ) = 0._wp            ! vertical diffusive fluxes 
    132                   zwt(:,:,jpk) = 0._wp   ;   zws(:,:,jpk) = 0._wp 
    133                   DO jk = 2, jpk 
    134                      zwt(:,:,jk) =   avt(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / fse3w(:,:,jk) * tmask(:,:,jk) 
    135                      zws(:,:,jk) = fsavs(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / fse3w(:,:,jk) * tmask(:,:,jk) 
    136                   END DO 
    137                   ! 
    138                   ztrdt(:,:,jpk) = 0._wp   ;   ztrds(:,:,jpk) = 0._wp 
    139                   DO jk = 1, jpkm1 
    140                      ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / fse3t(:,:,jk) 
    141                      ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / fse3t(:,:,jk)  
    142                   END DO 
    143                   CALL trd_tra_mng( ztrdt, ztrds, jptra_zdfp, kt )   
    144                   ! 
    145                   CALL wrk_dealloc( jpi, jpj, jpk, zwt, zws, ztrdt ) 
    146                   ! 
    147                ENDIF 
    148                ! 
    149             ELSE                              !  
    150                ztrds(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 
    151                CALL trd_tra_mng( trdt, ztrds, ktrd, kt )   
    152             ENDIF 
     126            zwt(:,:, 1 ) = 0._wp   ;   zws(:,:, 1 ) = 0._wp            ! vertical diffusive fluxes 
     127            zwt(:,:,jpk) = 0._wp   ;   zws(:,:,jpk) = 0._wp 
     128            DO jk = 2, jpk 
     129               zwt(:,:,jk) =   avt(:,:,jk) * ( tsa(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / fse3w(:,:,jk) * tmask(:,:,jk) 
     130               zws(:,:,jk) = fsavs(:,:,jk) * ( tsa(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / fse3w(:,:,jk) * tmask(:,:,jk) 
     131            END DO 
     132            ! 
     133            ztrdt(:,:,jpk) = 0._wp   ;   ztrds(:,:,jpk) = 0._wp 
     134            DO jk = 1, jpkm1 
     135               ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / fse3t(:,:,jk) 
     136               ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / fse3t(:,:,jk)  
     137            END DO 
     138            CALL trd_tra_mng( ztrdt, ztrds, jptra_zdfp, kt )   
     139            ! 
     140            CALL wrk_dealloc( jpi, jpj, jpk, zwt, zws, ztrdt ) 
     141            ! 
     142         CASE DEFAULT                 ! other trends: mask and send T & S trends to trd_tra_mng 
     143            ztrds(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 
     144            CALL trd_tra_mng( trdt, ztrds, ktrd, kt )   
     145         END SELECT 
    153146      ENDIF 
    154147 
    155148      IF( ctype == 'TRC' ) THEN                           !==  passive tracer trend  ==! 
    156149         ! 
    157          IF( PRESENT( ptra ) ) THEN                          ! advection: transform flux into a masked trend 
    158             SELECT CASE( ktrd ) 
    159             CASE( jptra_xad )   ;   CALL trd_tra_adv( ptrd , pun , ptra, 'X', ztrds )  
    160             CASE( jptra_yad )   ;   CALL trd_tra_adv( ptrd , pun , ptra, 'Y', ztrds )  
    161             CASE( jptra_zad )   ;   CALL trd_tra_adv( ptrd , pun , ptra, 'Z', ztrds )  
    162             END SELECT 
    163          ELSE                                                ! other trends: masked trend 
    164             ztrds(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 
    165          END IF 
    166          !                                  
    167          CALL trd_mod_trc( ztrds, ktra, ktrd, kt )           ! send trend to trd_mod_trc 
     150         SELECT CASE( ktrd ) 
     151         !                            ! advection: transform the advective flux into a masked trend 
     152         CASE( jptra_xad )   ;   CALL trd_tra_adv( ptrd , pun , ptra, 'X', ztrds )  
     153         CASE( jptra_yad )   ;   CALL trd_tra_adv( ptrd , pun , ptra, 'Y', ztrds )  
     154         CASE( jptra_zad )   ;   CALL trd_tra_adv( ptrd , pun , ptra, 'Z', ztrds )  
     155         CASE DEFAULT                 ! other trends: just masked  
     156                                 ztrds(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 
     157         END SELECT 
     158         !                            ! send trend to trd_mod_trc 
     159         CALL trd_mod_trc( ztrds, ktra, ktrd, kt )  
    168160         ! 
    169161      ENDIF 
     
    243235      !                   ! Integral Constraints Properties for tracers trends                                       !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    244236      IF( ln_glo_trd )   CALL trd_glo( ptrdx, ptrdy, ktrd, 'TRA', kt ) 
     237 
     238      !                   ! Potential ENergy trends 
     239      IF( ln_glo_trd )   CALL trd_pen( ptrdx, ptrdy, ktrd, kt, r2dt ) 
    245240 
    246241      !                   ! Mixed layer trends for active tracers 
Note: See TracChangeset for help on using the changeset viewer.