Changeset 10965 for NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/DIA/diadct.F90
- Timestamp:
- 2019-05-10T18:02:51+02:00 (5 years ago)
- 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 178 178 179 179 180 SUBROUTINE dia_dct( kt )180 SUBROUTINE dia_dct( kt, Kmm ) 181 181 !!--------------------------------------------------------------------- 182 182 !! *** ROUTINE diadct *** … … 195 195 !! Reinitialise all relevant arrays to zero 196 196 !!--------------------------------------------------------------------- 197 INTEGER, INTENT(in) :: kt 197 INTEGER, INTENT(in) :: kt ! ocean time step 198 INTEGER, INTENT(in) :: Kmm ! time level index 198 199 ! 199 200 INTEGER :: jsec ! loop on sections … … 235 236 236 237 !Compute transport through section 237 CALL transport( secs(jsec),lldebug,jsec)238 CALL transport(Kmm,secs(jsec),lldebug,jsec) 238 239 239 240 ENDDO … … 249 250 ! Sum over each class 250 251 DO jsec=1,nb_sec 251 CALL dia_dct_sum( secs(jsec),jsec)252 CALL dia_dct_sum(Kmm,secs(jsec),jsec) 252 253 ENDDO 253 254 … … 561 562 562 563 563 SUBROUTINE transport( sec,ld_debug,jsec)564 SUBROUTINE transport(Kmm,sec,ld_debug,jsec) 564 565 !!------------------------------------------------------------------------------------------- 565 566 !! *** ROUTINE transport *** … … 581 582 !! 582 583 !!------------------------------------------------------------------------------------------- 584 INTEGER ,INTENT(IN) :: Kmm ! time level index 583 585 TYPE(SECTION),INTENT(INOUT) :: sec 584 586 LOGICAL ,INTENT(IN) :: ld_debug … … 676 678 SELECT CASE( sec%direction(jseg) ) 677 679 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*( ssh n(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) 683 685 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*( ssh n(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) 689 691 END SELECT 690 692 ! 691 zdep= gdept _n(k%I,k%J,jk)693 zdep= gdept(k%I,k%J,jk,Kmm) 692 694 693 695 SELECT CASE( sec%direction(jseg) ) !compute velocity with the correct direction 694 696 CASE(0,1) 695 697 zumid=0._wp 696 zvmid=isgnv*v n(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) 697 699 CASE(2,3) 698 zumid=isgnu*u n(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) 699 701 zvmid=0._wp 700 702 END SELECT … … 702 704 !zTnorm=transport through one cell; 703 705 !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) 706 708 707 709 !!gm THIS is WRONG no transport due to ssh in linear free surface case !!!!! … … 768 770 769 771 770 SUBROUTINE dia_dct_sum( sec,jsec)772 SUBROUTINE dia_dct_sum(Kmm,sec,jsec) 771 773 !!------------------------------------------------------------- 772 774 !! Purpose: Average the transport over nn_dctwri time steps … … 787 789 !! 788 790 !!------------------------------------------------------------- 791 INTEGER ,INTENT(IN) :: Kmm ! time level index 789 792 TYPE(SECTION),INTENT(INOUT) :: sec 790 793 INTEGER ,INTENT(IN) :: jsec ! numeric identifier of section … … 848 851 SELECT CASE( sec%direction(jseg) ) 849 852 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) 854 857 855 858 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*( ssh n(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) 861 864 END SELECT 862 865 863 zdep= gdept _n(k%I,k%J,jk)866 zdep= gdept(k%I,k%J,jk,Kmm) 864 867 865 868 !------------------------------- … … 1104 1107 1105 1108 1106 FUNCTION interp( ki, kj, kk, cd_point, ptab)1109 FUNCTION interp(Kmm, ki, kj, kk, cd_point, ptab) 1107 1110 !!---------------------------------------------------------------------- 1108 1111 !! … … 1165 1168 !!---------------------------------------------------------------------- 1166 1169 !*arguments 1170 INTEGER, INTENT(IN) :: Kmm ! time level index 1167 1171 INTEGER, INTENT(IN) :: ki, kj, kk ! coordinate of point 1168 1172 CHARACTER(len=1), INTENT(IN) :: cd_point ! type of point (U, V) … … 1199 1203 IF( ln_sco )THEN ! s-coordinate case 1200 1204 1201 zdepu = ( gdept _n(ii1,ij1,kk) + gdept_n(ii2,ij2,kk) ) * 0.5_wp1202 zdep1 = gdept _n(ii1,ij1,kk) - zdepu1203 zdep2 = gdept _n(ii2,ij2,kk) - zdepu1205 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 1204 1208 1205 1209 ! weights … … 1213 1217 ELSE ! full step or partial step case 1214 1218 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) 1218 1222 1219 1223 IF(kk .NE. 1)THEN … … 1253 1257 END SUBROUTINE dia_dct_init 1254 1258 1255 SUBROUTINE dia_dct( kt ) ! Dummy routine1259 SUBROUTINE dia_dct( kt, Kmm ) ! Dummy routine 1256 1260 IMPLICIT NONE 1257 1261 INTEGER, INTENT( in ) :: kt ! ocean time-step index 1262 INTEGER, INTENT( in ) :: Kmm ! ocean time level index 1258 1263 WRITE(*,*) 'dia_dct: You should not have seen this print! error?', kt 1259 1264 END SUBROUTINE dia_dct
Note: See TracChangeset
for help on using the changeset viewer.