- Timestamp:
- 2019-11-22T15:29:17+01:00 (5 years ago)
- Location:
- NEMO/branches/2019/dev_r11943_MERGE_2019/src
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
OCE/DIA/diadct.F90 (modified) (16 diffs)
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/DIA/diadct.F90
r11536 r11949 175 175 176 176 177 SUBROUTINE dia_dct( kt )177 SUBROUTINE dia_dct( kt, Kmm ) 178 178 !!--------------------------------------------------------------------- 179 179 !! *** ROUTINE diadct *** … … 192 192 !! Reinitialise all relevant arrays to zero 193 193 !!--------------------------------------------------------------------- 194 INTEGER, INTENT(in) :: kt 194 INTEGER, INTENT(in) :: kt ! ocean time step 195 INTEGER, INTENT(in) :: Kmm ! time level index 195 196 ! 196 197 INTEGER :: jsec ! loop on sections … … 232 233 233 234 !Compute transport through section 234 CALL transport( secs(jsec),lldebug,jsec)235 CALL transport(Kmm,secs(jsec),lldebug,jsec) 235 236 236 237 ENDDO … … 246 247 ! Sum over each class 247 248 DO jsec=1,nb_sec 248 CALL dia_dct_sum( secs(jsec),jsec)249 CALL dia_dct_sum(Kmm,secs(jsec),jsec) 249 250 ENDDO 250 251 … … 558 559 559 560 560 SUBROUTINE transport( sec,ld_debug,jsec)561 SUBROUTINE transport(Kmm,sec,ld_debug,jsec) 561 562 !!------------------------------------------------------------------------------------------- 562 563 !! *** ROUTINE transport *** … … 578 579 !! 579 580 !!------------------------------------------------------------------------------------------- 581 INTEGER ,INTENT(IN) :: Kmm ! time level index 580 582 TYPE(SECTION),INTENT(INOUT) :: sec 581 583 LOGICAL ,INTENT(IN) :: ld_debug … … 673 675 SELECT CASE( sec%direction(jseg) ) 674 676 CASE(0,1) 675 ztn = interp( k%I,k%J,jk,'V',tsn(:,:,:,jp_tem) )676 zsn = interp( k%I,k%J,jk,'V',tsn(:,:,:,jp_sal) )677 zrhop = interp( k%I,k%J,jk,'V',rhop)678 zrhoi = interp( k%I,k%J,jk,'V',rhd*rau0+rau0)679 zsshn = 0.5*( ssh n(k%I,k%J) + sshn(k%I,k%J+1) ) * vmask(k%I,k%J,1)677 ztn = interp(Kmm,k%I,k%J,jk,'V',ts(:,:,:,jp_tem,Kmm) ) 678 zsn = interp(Kmm,k%I,k%J,jk,'V',ts(:,:,:,jp_sal,Kmm) ) 679 zrhop = interp(Kmm,k%I,k%J,jk,'V',rhop) 680 zrhoi = interp(Kmm,k%I,k%J,jk,'V',rhd*rau0+rau0) 681 zsshn = 0.5*( ssh(k%I,k%J,Kmm) + ssh(k%I,k%J+1,Kmm) ) * vmask(k%I,k%J,1) 680 682 CASE(2,3) 681 ztn = interp( k%I,k%J,jk,'U',tsn(:,:,:,jp_tem) )682 zsn = interp( k%I,k%J,jk,'U',tsn(:,:,:,jp_sal) )683 zrhop = interp( k%I,k%J,jk,'U',rhop)684 zrhoi = interp( k%I,k%J,jk,'U',rhd*rau0+rau0)685 zsshn = 0.5*( ssh n(k%I,k%J) + sshn(k%I+1,k%J) ) * umask(k%I,k%J,1)683 ztn = interp(Kmm,k%I,k%J,jk,'U',ts(:,:,:,jp_tem,Kmm) ) 684 zsn = interp(Kmm,k%I,k%J,jk,'U',ts(:,:,:,jp_sal,Kmm) ) 685 zrhop = interp(Kmm,k%I,k%J,jk,'U',rhop) 686 zrhoi = interp(Kmm,k%I,k%J,jk,'U',rhd*rau0+rau0) 687 zsshn = 0.5*( ssh(k%I,k%J,Kmm) + ssh(k%I+1,k%J,Kmm) ) * umask(k%I,k%J,1) 686 688 END SELECT 687 689 ! 688 zdep= gdept _n(k%I,k%J,jk)690 zdep= gdept(k%I,k%J,jk,Kmm) 689 691 690 692 SELECT CASE( sec%direction(jseg) ) !compute velocity with the correct direction 691 693 CASE(0,1) 692 694 zumid=0._wp 693 zvmid=isgnv*v n(k%I,k%J,jk)*vmask(k%I,k%J,jk)695 zvmid=isgnv*vv(k%I,k%J,jk,Kmm)*vmask(k%I,k%J,jk) 694 696 CASE(2,3) 695 zumid=isgnu*u n(k%I,k%J,jk)*umask(k%I,k%J,jk)697 zumid=isgnu*uu(k%I,k%J,jk,Kmm)*umask(k%I,k%J,jk) 696 698 zvmid=0._wp 697 699 END SELECT … … 699 701 !zTnorm=transport through one cell; 700 702 !velocity* cell's length * cell's thickness 701 zTnorm = zumid*e2u(k%I,k%J) * e3u _n(k%I,k%J,jk) &702 & + zvmid*e1v(k%I,k%J) * e3v _n(k%I,k%J,jk)703 zTnorm = zumid*e2u(k%I,k%J) * e3u(k%I,k%J,jk,Kmm) & 704 & + zvmid*e1v(k%I,k%J) * e3v(k%I,k%J,jk,Kmm) 703 705 704 706 !!gm THIS is WRONG no transport due to ssh in linear free surface case !!!!! … … 765 767 766 768 767 SUBROUTINE dia_dct_sum( sec,jsec)769 SUBROUTINE dia_dct_sum(Kmm,sec,jsec) 768 770 !!------------------------------------------------------------- 769 771 !! Purpose: Average the transport over nn_dctwri time steps … … 784 786 !! 785 787 !!------------------------------------------------------------- 788 INTEGER ,INTENT(IN) :: Kmm ! time level index 786 789 TYPE(SECTION),INTENT(INOUT) :: sec 787 790 INTEGER ,INTENT(IN) :: jsec ! numeric identifier of section … … 845 848 SELECT CASE( sec%direction(jseg) ) 846 849 CASE(0,1) 847 ztn = interp( k%I,k%J,jk,'V',tsn(:,:,:,jp_tem) )848 zsn = interp( k%I,k%J,jk,'V',tsn(:,:,:,jp_sal) )849 zrhop = interp( k%I,k%J,jk,'V',rhop)850 zrhoi = interp( k%I,k%J,jk,'V',rhd*rau0+rau0)850 ztn = interp(Kmm,k%I,k%J,jk,'V',ts(:,:,:,jp_tem,Kmm) ) 851 zsn = interp(Kmm,k%I,k%J,jk,'V',ts(:,:,:,jp_sal,Kmm) ) 852 zrhop = interp(Kmm,k%I,k%J,jk,'V',rhop) 853 zrhoi = interp(Kmm,k%I,k%J,jk,'V',rhd*rau0+rau0) 851 854 852 855 CASE(2,3) 853 ztn = interp( k%I,k%J,jk,'U',tsn(:,:,:,jp_tem) )854 zsn = interp( k%I,k%J,jk,'U',tsn(:,:,:,jp_sal) )855 zrhop = interp( k%I,k%J,jk,'U',rhop)856 zrhoi = interp( k%I,k%J,jk,'U',rhd*rau0+rau0)857 zsshn = 0.5*( ssh n(k%I,k%J) + sshn(k%I+1,k%J) ) * umask(k%I,k%J,1)856 ztn = interp(Kmm,k%I,k%J,jk,'U',ts(:,:,:,jp_tem,Kmm) ) 857 zsn = interp(Kmm,k%I,k%J,jk,'U',ts(:,:,:,jp_sal,Kmm) ) 858 zrhop = interp(Kmm,k%I,k%J,jk,'U',rhop) 859 zrhoi = interp(Kmm,k%I,k%J,jk,'U',rhd*rau0+rau0) 860 zsshn = 0.5*( ssh(k%I,k%J,Kmm) + ssh(k%I+1,k%J,Kmm) ) * umask(k%I,k%J,1) 858 861 END SELECT 859 862 860 zdep= gdept _n(k%I,k%J,jk)863 zdep= gdept(k%I,k%J,jk,Kmm) 861 864 862 865 !------------------------------- … … 1101 1104 1102 1105 1103 FUNCTION interp( ki, kj, kk, cd_point, ptab)1106 FUNCTION interp(Kmm, ki, kj, kk, cd_point, ptab) 1104 1107 !!---------------------------------------------------------------------- 1105 1108 !! … … 1162 1165 !!---------------------------------------------------------------------- 1163 1166 !*arguments 1167 INTEGER, INTENT(IN) :: Kmm ! time level index 1164 1168 INTEGER, INTENT(IN) :: ki, kj, kk ! coordinate of point 1165 1169 CHARACTER(len=1), INTENT(IN) :: cd_point ! type of point (U, V) … … 1196 1200 IF( ln_sco )THEN ! s-coordinate case 1197 1201 1198 zdepu = ( gdept _n(ii1,ij1,kk) + gdept_n(ii2,ij2,kk) ) * 0.5_wp1199 zdep1 = gdept _n(ii1,ij1,kk) - zdepu1200 zdep2 = gdept _n(ii2,ij2,kk) - zdepu1202 zdepu = ( gdept(ii1,ij1,kk,Kmm) + gdept(ii2,ij2,kk,Kmm) ) * 0.5_wp 1203 zdep1 = gdept(ii1,ij1,kk,Kmm) - zdepu 1204 zdep2 = gdept(ii2,ij2,kk,Kmm) - zdepu 1201 1205 1202 1206 ! weights … … 1210 1214 ELSE ! full step or partial step case 1211 1215 1212 ze3t = e3t _n(ii2,ij2,kk) - e3t_n(ii1,ij1,kk)1213 zwgt1 = ( e3w _n(ii2,ij2,kk) - e3w_n(ii1,ij1,kk) ) / e3w_n(ii2,ij2,kk)1214 zwgt2 = ( e3w _n(ii1,ij1,kk) - e3w_n(ii2,ij2,kk) ) / e3w_n(ii1,ij1,kk)1216 ze3t = e3t(ii2,ij2,kk,Kmm) - e3t(ii1,ij1,kk,Kmm) 1217 zwgt1 = ( e3w(ii2,ij2,kk,Kmm) - e3w(ii1,ij1,kk,Kmm) ) / e3w(ii2,ij2,kk,Kmm) 1218 zwgt2 = ( e3w(ii1,ij1,kk,Kmm) - e3w(ii2,ij2,kk,Kmm) ) / e3w(ii1,ij1,kk,Kmm) 1215 1219 1216 1220 IF(kk .NE. 1)THEN … … 1245 1249 IMPLICIT NONE 1246 1250 END SUBROUTINE dia_dct_init 1247 SUBROUTINE dia_dct( kt ) 1251 1252 SUBROUTINE dia_dct( kt, Kmm ) ! Dummy routine 1248 1253 IMPLICIT NONE 1249 INTEGER, INTENT(in) :: kt 1254 INTEGER, INTENT( in ) :: kt ! ocean time-step index 1255 INTEGER, INTENT( in ) :: Kmm ! ocean time level index 1256 WRITE(*,*) 'dia_dct: You should not have seen this print! error?', kt 1250 1257 END SUBROUTINE dia_dct 1251 1258 !
Note: See TracChangeset
for help on using the changeset viewer.
