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 11949 for NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRD/trdpen.F90 – NEMO

Ignore:
Timestamp:
2019-11-22T15:29:17+01:00 (4 years ago)
Author:
acc
Message:

Merge in changes from 2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps. This just creates a fresh copy of this branch to use as the merge base. See ticket #2341

Location:
NEMO/branches/2019/dev_r11943_MERGE_2019/src
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11943_MERGE_2019/src

    • Property svn:mergeinfo deleted
  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRD/trdpen.F90

    r10425 r11949  
    5555 
    5656 
    57    SUBROUTINE trd_pen( ptrdx, ptrdy, ktrd, kt, pdt ) 
     57   SUBROUTINE trd_pen( ptrdx, ptrdy, ktrd, kt, pdt, Kmm ) 
    5858      !!--------------------------------------------------------------------- 
    5959      !!                  ***  ROUTINE trd_tra_mng  *** 
     
    6666      INTEGER                   , INTENT(in) ::   ktrd           ! tracer trend index 
    6767      INTEGER                   , INTENT(in) ::   kt             ! time step index 
     68      INTEGER                   , INTENT(in) ::   Kmm            ! time level index 
    6869      REAL(wp)                  , INTENT(in) ::   pdt            ! time step [s] 
    6970      ! 
     
    7778      IF( kt /= nkstp ) THEN     ! full eos: set partial derivatives at the 1st call of kt time step 
    7879         nkstp = kt 
    79          CALL eos_pen( tsn, rab_PE, zpe ) 
     80         CALL eos_pen( ts(:,:,:,:,Kmm), rab_PE, zpe, Kmm ) 
    8081         CALL iom_put( "alphaPE", rab_pe(:,:,:,jp_tem) ) 
    8182         CALL iom_put( "betaPE" , rab_pe(:,:,:,jp_sal) ) 
     
    9596                                IF( ln_linssh ) THEN                   ! cst volume : adv flux through z=0 surface 
    9697                                   ALLOCATE( z2d(jpi,jpj) ) 
    97                                    z2d(:,:) = wn(:,:,1) * ( & 
    98                                      &   - ( rab_n(:,:,1,jp_tem) + rab_pe(:,:,1,jp_tem) ) * tsn(:,:,1,jp_tem)    & 
    99                                      &   + ( rab_n(:,:,1,jp_sal) + rab_pe(:,:,1,jp_sal) ) * tsn(:,:,1,jp_sal)    & 
    100                                      & ) / e3t_n(:,:,1) 
     98                                   z2d(:,:) = ww(:,:,1) * ( & 
     99                                     &   - ( rab_n(:,:,1,jp_tem) + rab_pe(:,:,1,jp_tem) ) * ts(:,:,1,jp_tem,Kmm)    & 
     100                                     &   + ( rab_n(:,:,1,jp_sal) + rab_pe(:,:,1,jp_sal) ) * ts(:,:,1,jp_sal,Kmm)    & 
     101                                     & ) / e3t(:,:,1,Kmm) 
    101102                                   CALL iom_put( "petrd_sad" , z2d ) 
    102103                                   DEALLOCATE( z2d ) 
     
    112113      CASE ( jptra_bbc  )   ;   CALL iom_put( "petrd_bbc" , zpe )   ! bottom bound cond (geoth flux) 
    113114      CASE ( jptra_atf  )   ;   CALL iom_put( "petrd_atf" , zpe )   ! asselin time filter (last trend) 
    114                                 !IF( ln_linssh ) THEN                   ! cst volume : ssh term (otherwise include in e3t variation) 
    115                                 !   ALLOCATE( z2d(jpi,jpj) ) 
    116                                 !   z2d(:,:) = ( ssha(:,:) - sshb(:,:) )                 & 
    117                                 !      &     * (   dPE_dt(:,:,1) * tsn(:,:,1,jp_tem)    & 
    118                                 !      &         + dPE_ds(:,:,1) * tsn(:,:,1,jp_sal)  ) / ( e3t_n(:,:,1) * pdt ) 
    119                                 !   CALL iom_put( "petrd_sad" , z2d ) 
    120                                 !   DEALLOCATE( z2d ) 
    121                                 !ENDIF 
    122115         ! 
    123116      END SELECT 
Note: See TracChangeset for help on using the changeset viewer.