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 10965 for NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/DIA/diadct.F90 – NEMO

Ignore:
Timestamp:
2019-05-10T18:02:51+02:00 (5 years ago)
Author:
davestorkey
Message:

2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps : DIA and stpctl.F90. Just testing in ORCA1 so far.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/DIA/diadct.F90

    r10425 r10965  
    178178  
    179179  
    180   SUBROUTINE dia_dct( kt ) 
     180  SUBROUTINE dia_dct( kt, Kmm ) 
    181181     !!--------------------------------------------------------------------- 
    182182     !!               ***  ROUTINE diadct  ***   
     
    195195     !!               Reinitialise all relevant arrays to zero  
    196196     !!--------------------------------------------------------------------- 
    197      INTEGER, INTENT(in) ::   kt 
     197     INTEGER, INTENT(in) ::   kt    ! ocean time step 
     198     INTEGER, INTENT(in) ::   Kmm   ! time level index 
    198199     ! 
    199200     INTEGER ::   jsec              ! loop on sections 
     
    235236 
    236237           !Compute transport through section   
    237            CALL transport(secs(jsec),lldebug,jsec)  
     238           CALL transport(Kmm,secs(jsec),lldebug,jsec)  
    238239 
    239240        ENDDO 
     
    249250           ! Sum over each class  
    250251           DO jsec=1,nb_sec  
    251               CALL dia_dct_sum(secs(jsec),jsec)  
     252              CALL dia_dct_sum(Kmm,secs(jsec),jsec)  
    252253           ENDDO  
    253254 
     
    561562 
    562563 
    563    SUBROUTINE transport(sec,ld_debug,jsec) 
     564   SUBROUTINE transport(Kmm,sec,ld_debug,jsec) 
    564565     !!------------------------------------------------------------------------------------------- 
    565566     !!                     ***  ROUTINE transport  *** 
     
    581582     !! 
    582583     !!------------------------------------------------------------------------------------------- 
     584     INTEGER      ,INTENT(IN)    :: Kmm         ! time level index 
    583585     TYPE(SECTION),INTENT(INOUT) :: sec 
    584586     LOGICAL      ,INTENT(IN)    :: ld_debug 
     
    676678            SELECT CASE( sec%direction(jseg) ) 
    677679               CASE(0,1)  
    678                   ztn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_tem) )  
    679                   zsn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_sal) )  
    680                   zrhop = interp(k%I,k%J,jk,'V',rhop)  
    681                   zrhoi = interp(k%I,k%J,jk,'V',rhd*rau0+rau0)  
    682                   zsshn =  0.5*( sshn(k%I,k%J) + sshn(k%I,k%J+1)    ) * vmask(k%I,k%J,1)  
     680                  ztn   = interp(Kmm,k%I,k%J,jk,'V',ts(:,:,:,jp_tem,Kmm) )  
     681                  zsn   = interp(Kmm,k%I,k%J,jk,'V',ts(:,:,:,jp_sal,Kmm) )  
     682                  zrhop = interp(Kmm,k%I,k%J,jk,'V',rhop)  
     683                  zrhoi = interp(Kmm,k%I,k%J,jk,'V',rhd*rau0+rau0)  
     684                  zsshn =  0.5*( ssh(k%I,k%J,Kmm) + ssh(k%I,k%J+1,Kmm)    ) * vmask(k%I,k%J,1)  
    683685               CASE(2,3)  
    684                   ztn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_tem) )  
    685                   zsn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_sal) )  
    686                   zrhop = interp(k%I,k%J,jk,'U',rhop)  
    687                   zrhoi = interp(k%I,k%J,jk,'U',rhd*rau0+rau0)  
    688                   zsshn =  0.5*( sshn(k%I,k%J) + sshn(k%I+1,k%J)    ) * umask(k%I,k%J,1)   
     686                  ztn   = interp(Kmm,k%I,k%J,jk,'U',ts(:,:,:,jp_tem,Kmm) )  
     687                  zsn   = interp(Kmm,k%I,k%J,jk,'U',ts(:,:,:,jp_sal,Kmm) )  
     688                  zrhop = interp(Kmm,k%I,k%J,jk,'U',rhop)  
     689                  zrhoi = interp(Kmm,k%I,k%J,jk,'U',rhd*rau0+rau0)  
     690                  zsshn =  0.5*( ssh(k%I,k%J,Kmm) + ssh(k%I+1,k%J,Kmm)    ) * umask(k%I,k%J,1)   
    689691               END SELECT  
    690692               ! 
    691                zdep= gdept_n(k%I,k%J,jk)  
     693               zdep= gdept(k%I,k%J,jk,Kmm)  
    692694   
    693695               SELECT CASE( sec%direction(jseg) )                !compute velocity with the correct direction  
    694696               CASE(0,1)    
    695697                  zumid=0._wp 
    696                   zvmid=isgnv*vn(k%I,k%J,jk)*vmask(k%I,k%J,jk)  
     698                  zvmid=isgnv*vv(k%I,k%J,jk,Kmm)*vmask(k%I,k%J,jk)  
    697699               CASE(2,3)  
    698                   zumid=isgnu*un(k%I,k%J,jk)*umask(k%I,k%J,jk)  
     700                  zumid=isgnu*uu(k%I,k%J,jk,Kmm)*umask(k%I,k%J,jk)  
    699701                  zvmid=0._wp 
    700702               END SELECT  
     
    702704               !zTnorm=transport through one cell;  
    703705               !velocity* cell's length * cell's thickness  
    704                zTnorm = zumid*e2u(k%I,k%J) * e3u_n(k%I,k%J,jk)     &  
    705                   &   + zvmid*e1v(k%I,k%J) * e3v_n(k%I,k%J,jk)  
     706               zTnorm = zumid*e2u(k%I,k%J) * e3u(k%I,k%J,jk,Kmm)     &  
     707                  &   + zvmid*e1v(k%I,k%J) * e3v(k%I,k%J,jk,Kmm)  
    706708 
    707709!!gm  THIS is WRONG  no transport due to ssh in linear free surface case !!!!! 
     
    768770 
    769771 
    770   SUBROUTINE dia_dct_sum(sec,jsec)  
     772  SUBROUTINE dia_dct_sum(Kmm,sec,jsec)  
    771773     !!-------------------------------------------------------------  
    772774     !! Purpose: Average the transport over nn_dctwri time steps   
     
    787789     !!  
    788790     !!-------------------------------------------------------------  
     791     INTEGER      ,INTENT(IN)    :: Kmm         ! time level index 
    789792     TYPE(SECTION),INTENT(INOUT) :: sec  
    790793     INTEGER      ,INTENT(IN)    :: jsec        ! numeric identifier of section  
     
    848851              SELECT CASE( sec%direction(jseg) )  
    849852              CASE(0,1)  
    850                  ztn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_tem) )  
    851                  zsn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_sal) )  
    852                  zrhop = interp(k%I,k%J,jk,'V',rhop)  
    853                  zrhoi = interp(k%I,k%J,jk,'V',rhd*rau0+rau0)  
     853                 ztn   = interp(Kmm,k%I,k%J,jk,'V',ts(:,:,:,jp_tem,Kmm) )  
     854                 zsn   = interp(Kmm,k%I,k%J,jk,'V',ts(:,:,:,jp_sal,Kmm) )  
     855                 zrhop = interp(Kmm,k%I,k%J,jk,'V',rhop)  
     856                 zrhoi = interp(Kmm,k%I,k%J,jk,'V',rhd*rau0+rau0)  
    854857 
    855858              CASE(2,3)  
    856                  ztn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_tem) )  
    857                  zsn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_sal) )  
    858                  zrhop = interp(k%I,k%J,jk,'U',rhop)  
    859                  zrhoi = interp(k%I,k%J,jk,'U',rhd*rau0+rau0)  
    860                  zsshn =  0.5*( sshn(k%I,k%J)    + sshn(k%I+1,k%J)    ) * umask(k%I,k%J,1)   
     859                 ztn   = interp(Kmm,k%I,k%J,jk,'U',ts(:,:,:,jp_tem,Kmm) )  
     860                 zsn   = interp(Kmm,k%I,k%J,jk,'U',ts(:,:,:,jp_sal,Kmm) )  
     861                 zrhop = interp(Kmm,k%I,k%J,jk,'U',rhop)  
     862                 zrhoi = interp(Kmm,k%I,k%J,jk,'U',rhd*rau0+rau0)  
     863                 zsshn =  0.5*( ssh(k%I,k%J,Kmm)    + ssh(k%I+1,k%J,Kmm)    ) * umask(k%I,k%J,1)   
    861864              END SELECT  
    862865  
    863               zdep= gdept_n(k%I,k%J,jk)  
     866              zdep= gdept(k%I,k%J,jk,Kmm)  
    864867   
    865868              !-------------------------------  
     
    11041107 
    11051108 
    1106    FUNCTION interp(ki, kj, kk, cd_point, ptab) 
     1109   FUNCTION interp(Kmm, ki, kj, kk, cd_point, ptab) 
    11071110  !!---------------------------------------------------------------------- 
    11081111  !! 
     
    11651168  !!---------------------------------------------------------------------- 
    11661169  !*arguments 
     1170  INTEGER, INTENT(IN)                          :: Kmm          ! time level index 
    11671171  INTEGER, INTENT(IN)                          :: ki, kj, kk   ! coordinate of point 
    11681172  CHARACTER(len=1), INTENT(IN)                 :: cd_point     ! type of point (U, V) 
     
    11991203  IF( ln_sco )THEN   ! s-coordinate case 
    12001204 
    1201      zdepu = ( gdept_n(ii1,ij1,kk) +  gdept_n(ii2,ij2,kk) ) * 0.5_wp  
    1202      zdep1 = gdept_n(ii1,ij1,kk) - zdepu 
    1203      zdep2 = gdept_n(ii2,ij2,kk) - zdepu 
     1205     zdepu = ( gdept(ii1,ij1,kk,Kmm) +  gdept(ii2,ij2,kk,Kmm) ) * 0.5_wp  
     1206     zdep1 = gdept(ii1,ij1,kk,Kmm) - zdepu 
     1207     zdep2 = gdept(ii2,ij2,kk,Kmm) - zdepu 
    12041208 
    12051209     ! weights 
     
    12131217  ELSE       ! full step or partial step case  
    12141218 
    1215      ze3t  = e3t_n(ii2,ij2,kk) - e3t_n(ii1,ij1,kk)  
    1216      zwgt1 = ( e3w_n(ii2,ij2,kk) - e3w_n(ii1,ij1,kk) ) / e3w_n(ii2,ij2,kk) 
    1217      zwgt2 = ( e3w_n(ii1,ij1,kk) - e3w_n(ii2,ij2,kk) ) / e3w_n(ii1,ij1,kk) 
     1219     ze3t  = e3t(ii2,ij2,kk,Kmm) - e3t(ii1,ij1,kk,Kmm)  
     1220     zwgt1 = ( e3w(ii2,ij2,kk,Kmm) - e3w(ii1,ij1,kk,Kmm) ) / e3w(ii2,ij2,kk,Kmm) 
     1221     zwgt2 = ( e3w(ii1,ij1,kk,Kmm) - e3w(ii2,ij2,kk,Kmm) ) / e3w(ii1,ij1,kk,Kmm) 
    12181222 
    12191223     IF(kk .NE. 1)THEN 
     
    12531257   END SUBROUTINE dia_dct_init 
    12541258 
    1255    SUBROUTINE dia_dct( kt )         ! Dummy routine 
     1259   SUBROUTINE dia_dct( kt, Kmm )         ! Dummy routine 
    12561260      IMPLICIT NONE 
    12571261      INTEGER, INTENT( in ) :: kt   ! ocean time-step index 
     1262      INTEGER, INTENT( in ) :: Kmm  ! ocean time level index 
    12581263      WRITE(*,*) 'dia_dct: You should not have seen this print! error?', kt 
    12591264   END SUBROUTINE dia_dct 
Note: See TracChangeset for help on using the changeset viewer.