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 9472 for branches – NEMO

Changeset 9472 for branches


Ignore:
Timestamp:
2018-04-12T17:29:18+02:00 (6 years ago)
Author:
deazer
Message:

Speed up NOOS transects

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/AMM15_v3_6_STABLE_package_withNOOS/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90

    r9194 r9472  
    814814              SELECT CASE( sec%direction(jseg) )  
    815815              CASE(0,1)  
    816                  ztn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_tem) )  
    817                  zsn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_sal) )  
    818                  zrhop = interp(k%I,k%J,jk,'V',rhop)  
    819                  zrhoi = interp(k%I,k%J,jk,'V',rhd*rau0+rau0)  
     816                 ztn   = interp(k%I,k%J,jk,'V',0 )  
     817                 zsn   = interp(k%I,k%J,jk,'V',1 )  
     818                 zrhop = interp(k%I,k%J,jk,'V',2 )  
     819                 zrhoi = interp(k%I,k%J,jk,'V',3 )  
    820820                 zsshn =  0.5*( sshn(k%I,k%J)    + sshn(k%I,k%J+1)    ) * vmask(k%I,k%J,1)  
    821821              CASE(2,3)  
    822                  ztn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_tem) )  
    823                  zsn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_sal) )  
    824                  zrhop = interp(k%I,k%J,jk,'U',rhop)  
    825                  zrhoi = interp(k%I,k%J,jk,'U',rhd*rau0+rau0)  
     822                 ztn   = interp(k%I,k%J,jk,'U',0 )  
     823                 zsn   = interp(k%I,k%J,jk,'U',1 )  
     824                 zrhop = interp(k%I,k%J,jk,'U',2 )  
     825                 zrhoi = interp(k%I,k%J,jk,'U',3 )  
    826826                 zsshn =  0.5*( sshn(k%I,k%J)    + sshn(k%I+1,k%J)    ) * umask(k%I,k%J,1)   
    827827              END SELECT  
     
    10391039              SELECT CASE( sec%direction(jseg) ) 
    10401040              CASE(0,1) 
    1041                  ztn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_tem) ) 
    1042                  zsn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_sal) ) 
    1043                  zrhop = interp(k%I,k%J,jk,'V',rhop) 
    1044                  zrhoi = interp(k%I,k%J,jk,'V',rhd*rau0+rau0) 
     1041                 ztn   = interp(k%I,k%J,jk,'V',0 ) 
     1042                 zsn   = interp(k%I,k%J,jk,'V',1) 
     1043                 zrhop = interp(k%I,k%J,jk,'V',2) 
     1044                 zrhoi = interp(k%I,k%J,jk,'V',3) 
    10451045                 zsshn =  0.5*( sshn(k%I,k%J)    + sshn(k%I,k%J+1)    ) * vmask(k%I,k%J,1) 
    10461046              CASE(2,3) 
    1047                  ztn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_tem) ) 
    1048                  zsn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_sal) ) 
    1049                  zrhop = interp(k%I,k%J,jk,'U',rhop) 
    1050                  zrhoi = interp(k%I,k%J,jk,'U',rhd*rau0+rau0) 
     1047                 ztn   = interp(k%I,k%J,jk,'U',0) 
     1048                 zsn   = interp(k%I,k%J,jk,'U',1) 
     1049                 zrhop = interp(k%I,k%J,jk,'U',2) 
     1050                 zrhoi = interp(k%I,k%J,jk,'U',3) 
    10511051                 zsshn =  0.5*( sshn(k%I,k%J)    + sshn(k%I+1,k%J)    ) * umask(k%I,k%J,1)  
    10521052              END SELECT 
     
    12101210              SELECT CASE( sec%direction(jseg) )  
    12111211              CASE(0,1)  
    1212                  ztn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_tem) )  
    1213                  zsn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_sal) )  
    1214                  zrhop = interp(k%I,k%J,jk,'V',rhop)  
    1215                  zrhoi = interp(k%I,k%J,jk,'V',rhd*rau0+rau0)  
     1212                 ztn   = interp(k%I,k%J,jk,'V',0 )  
     1213                 zsn   = interp(k%I,k%J,jk,'V',1 )  
     1214                 zrhop = interp(k%I,k%J,jk,'V',2)  
     1215                 zrhoi = interp(k%I,k%J,jk,'V',3)  
    12161216 
    12171217              CASE(2,3)  
    1218                  ztn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_tem) )  
    1219                  zsn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_sal) )  
    1220                  zrhop = interp(k%I,k%J,jk,'U',rhop)  
    1221                  zrhoi = interp(k%I,k%J,jk,'U',rhd*rau0+rau0)  
     1218                 ztn   = interp(k%I,k%J,jk,'U',0 )  
     1219                 zsn   = interp(k%I,k%J,jk,'U',1 )  
     1220                 zrhop = interp(k%I,k%J,jk,'U',2 )  
     1221                 zrhoi = interp(k%I,k%J,jk,'U',3 )  
    12221222                 zsshn =  0.5*( sshn(k%I,k%J)    + sshn(k%I+1,k%J)    ) * umask(k%I,k%J,1)   
    12231223              END SELECT  
     
    14211421              SELECT CASE( sec%direction(jseg) ) 
    14221422              CASE(0,1) 
    1423                  ztn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_tem) ) 
    1424                  zsn   = interp(k%I,k%J,jk,'V',tsn(:,:,:,jp_sal) ) 
    1425                  zrhop = interp(k%I,k%J,jk,'V',rhop) 
    1426                  zrhoi = interp(k%I,k%J,jk,'V',rhd*rau0+rau0) 
     1423                 ztn   = interp(k%I,k%J,jk,'V',0 ) 
     1424                 zsn   = interp(k%I,k%J,jk,'V',1 ) 
     1425                 zrhop = interp(k%I,k%J,jk,'V',2 ) 
     1426                 zrhoi = interp(k%I,k%J,jk,'V',3 ) 
    14271427                 zsshn =  0.5*( sshn(k%I,k%J)    + sshn(k%I,k%J+1)    ) * vmask(k%I,k%J,1) 
    14281428              CASE(2,3) 
    1429                  ztn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_tem) ) 
    1430                  zsn   = interp(k%I,k%J,jk,'U',tsn(:,:,:,jp_sal) ) 
    1431                  zrhop = interp(k%I,k%J,jk,'U',rhop) 
    1432                  zrhoi = interp(k%I,k%J,jk,'U',rhd*rau0+rau0) 
     1429                 ztn   = interp(k%I,k%J,jk,'U',0 ) 
     1430                 zsn   = interp(k%I,k%J,jk,'U',1 ) 
     1431                 zrhop = interp(k%I,k%J,jk,'U',2 ) 
     1432                 zrhoi = interp(k%I,k%J,jk,'U',3 ) 
    14331433                 zsshn =  0.5*( sshn(k%I,k%J)    + sshn(k%I+1,k%J)    ) * umask(k%I,k%J,1)  
    14341434              END SELECT 
     
    18691869  END SUBROUTINE dia_dct_wri 
    18701870 
    1871   FUNCTION interp(ki, kj, kk, cd_point, ptab) 
     1871   PURE  FUNCTION interp(ki, kj, kk, cd_point,var)  
    18721872  !!---------------------------------------------------------------------- 
    18731873  !! 
     
    19311931  !*arguments 
    19321932  INTEGER, INTENT(IN)                          :: ki, kj, kk   ! coordinate of point 
     1933  INTEGER, INTENT(IN)                          :: var   !  which variable 
    19331934  CHARACTER(len=1), INTENT(IN)                 :: cd_point     ! type of point (U, V) 
    1934   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(IN) :: ptab         ! variable to compute at (ki, kj, kk ) 
    19351935  REAL(wp)                                     :: interp       ! interpolated variable  
    19361936 
     
    19431943  !!---------------------------------------------------------------------- 
    19441944 
     1945  
     1946 
    19451947  IF( cd_point=='U' )THEN  
    19461948     ii1 = ki    ; ij1 = kj  
     
    19731975   
    19741976     ! result 
    1975      interp = zmsk * ( zwgt2 *  ptab(ii1,ij1,kk) + zwgt1 *  ptab(ii1,ij1,kk) ) / ( zwgt2 + zwgt1 )    
    1976  
     1977           SELECT CASE( var ) 
     1978              CASE(0)  ;    interp = zmsk * ( zwgt2 *  tsn(ii1,ij1,kk,jp_tem) + zwgt1 *  tsn(ii1,ij1,kk,jp_tem) ) / ( zwgt2 + zwgt1 ) 
     1979              CASE(1)  ;    interp = zmsk * ( zwgt2 *  tsn(ii1,ij1,kk,jp_sal) + zwgt1 *  tsn(ii1,ij1,kk,jp_sal) ) / ( zwgt2 + zwgt1 ) 
     1980              CASE(2)  ;    interp = zmsk * ( zwgt2 *  rhop(ii1,ij1,kk) + zwgt1 *  rhop(ii1,ij1,kk) ) / ( zwgt2 + zwgt1 ) 
     1981              CASE(3)  ;    interp = zmsk * ( zwgt2 *  (rhd(ii1,ij1,kk)*rau0+rau0) + zwgt1 *  (rhd(ii1,ij1,kk)*rau0+rau0) ) / ( zwgt2 + zwgt1 ) 
     1982           END SELECT 
    19771983 
    19781984  ELSE       ! full step or partial step case  
     
    19962002        IF( ze3t >= 0. )THEN  
    19972003           ! zbis 
    1998            zbis = ptab(ii2,ij2,kk) + zwgt1 * ( ptab(ii2,ij2,kk-1) - ptab(ii2,ij2,kk) )  
     2004           SELECT CASE( var ) 
     2005           CASE(0)   
     2006                     zbis   =  tsn(ii2,ij2,kk,jp_tem) + zwgt1 *  (tsn(ii2,ij2,kk-1,jp_tem)-tsn(ii2,ij2,kk,jp_tem)   ) 
     2007                     interp =  zmsk * ( zet2 * tsn(ii1,ij1,kk,jp_tem) + zet1 * zbis )/( zet1 + zet2 ) 
     2008           CASE(1)   
     2009                     zbis   =  tsn(ii2,ij2,kk,jp_sal) + zwgt1 *  (tsn(ii2,ij2,kk-1,jp_sal)-tsn(ii2,ij2,kk,jp_sal)   ) 
     2010                     interp =  zmsk * ( zet2 * tsn(ii1,ij1,kk,jp_sal) + zet1 * zbis )/( zet1 + zet2 ) 
     2011           CASE(2)   
     2012                     zbis   =  rhop(ii2,ij2,kk) + zwgt1 *  (rhop(ii2,ij2,kk-1)-rhop(ii2,ij2,kk)   ) 
     2013                     interp =  zmsk * ( zet2 * rhop(ii1,ij1,kk) + zet1 * zbis )/( zet1 + zet2 ) 
     2014           CASE(3)   
     2015                     zbis   =  (rhd(ii2,ij2,kk)*rau0+rau0) + zwgt1 *  ( (rhd(ii2,ij2,kk-1)*rau0+rau0)-(rhd(ii2,ij2,kk)*rau0+rau0)   ) 
     2016                     interp =  zmsk * ( zet2 * (rhd(ii1,ij1,kk)*rau0+rau0) + zet1 * zbis )/( zet1 + zet2 ) 
     2017           END SELECT 
    19992018           ! result 
    2000             interp = zmsk * ( zet2 * ptab(ii1,ij1,kk) + zet1 * zbis )/( zet1 + zet2 ) 
    20012019        ELSE 
    20022020           ! zbis 
    2003            zbis = ptab(ii1,ij1,kk) + zwgt2 * ( ptab(ii1,ij1,kk-1) - ptab(ii1,ij2,kk) ) 
    2004            ! result 
    2005            interp = zmsk * ( zet2 * zbis + zet1 * ptab(ii2,ij2,kk) )/( zet1 + zet2 ) 
     2021           SELECT CASE( var ) 
     2022           CASE(0)   
     2023                 zbis   = tsn(ii1,ij1,kk,jp_tem) + zwgt2 * ( tsn(ii1,ij1,kk-1,jp_tem) - tsn(ii1,ij2,kk,jp_tem) ) 
     2024                 interp = zmsk * ( zet2 * zbis + zet1 * tsn(ii2,ij2,kk,jp_tem) )/( zet1 + zet2 ) 
     2025           CASE(1)   
     2026                 zbis   = tsn(ii1,ij1,kk,jp_sal) + zwgt2 * ( tsn(ii1,ij1,kk-1,jp_sal) - tsn(ii1,ij2,kk,jp_sal) ) 
     2027                 interp = zmsk * ( zet2 * zbis + zet1 * tsn(ii2,ij2,kk,jp_sal) )/( zet1 + zet2 ) 
     2028           CASE(2)   
     2029                 zbis   = rhop(ii1,ij1,kk) + zwgt2 * ( rhop(ii1,ij1,kk-1) - rhop(ii1,ij2,kk) ) 
     2030                 interp = zmsk * ( zet2 * zbis + zet1 * rhop(ii2,ij2,kk) )/( zet1 + zet2 ) 
     2031           CASE(3)   
     2032                 zbis   = (rhd(ii1,ij1,kk)*rau0+rau0) + zwgt2 * ( (rhd(ii1,ij1,kk-1)*rau0+rau0) - (rhd(ii1,ij2,kk)*rau0+rau0) ) 
     2033                 interp = zmsk * ( zet2 * zbis + zet1 * (rhd(ii2,ij2,kk)*rau0+rau0) )/( zet1 + zet2 ) 
     2034           END SELECT 
    20062035        ENDIF     
    20072036 
    20082037     ELSE 
    2009         interp = zmsk * (  zet2 * ptab(ii1,ij1,kk) + zet1 * ptab(ii2,ij2,kk) )/( zet1 + zet2 ) 
     2038        SELECT CASE( var ) 
     2039        CASE(0)   
     2040           interp = zmsk * (  zet2 * tsn(ii1,ij1,kk,jp_tem) + zet1 * tsn(ii2,ij2,kk,jp_tem) )/( zet1 + zet2 ) 
     2041        CASE(1)   
     2042           interp = zmsk * (  zet2 * tsn(ii1,ij1,kk,jp_sal) + zet1 * tsn(ii2,ij2,kk,jp_sal) )/( zet1 + zet2 ) 
     2043        CASE(2)   
     2044           interp = zmsk * (  zet2 * rhop(ii1,ij1,kk) + zet1 * rhop(ii2,ij2,kk) )/( zet1 + zet2 ) 
     2045        CASE(3)   
     2046           interp = zmsk * (  zet2 * (rhd(ii1,ij1,kk)*rau0+rau0) + zet1 * (rhd(ii2,ij2,kk)*rau0+rau0) )/( zet1 + zet2 ) 
     2047        END SELECT 
    20102048     ENDIF 
    20112049 
    20122050  ENDIF 
    2013  
    20142051 
    20152052  END FUNCTION interp 
Note: See TracChangeset for help on using the changeset viewer.