Ignore:
Timestamp:
2017-04-23T09:30:41+02:00 (3 years ago)
Author:
gm
Message:

#1880 (HPC-09): add zdfphy (the ZDF manager) + remove all key_…

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90

    r7646 r7953  
    2121   USE oce 
    2222   USE dom_oce       
    23    USE zdf_oce 
     23   USE zdf_oce          ! vertical physics 
    2424   USE agrif_oce 
    2525   USE phycst 
     
    3434 
    3535   PUBLIC   Agrif_tra, Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ssh_ts, Agrif_dta_ts 
    36    PUBLIC   interpun, interpvn 
    37    PUBLIC   interptsn,  interpsshn 
    38    PUBLIC   interpunb, interpvnb, interpub2b, interpvb2b 
     36   PUBLIC   interpun , interpvn 
     37   PUBLIC   interptsn, interpsshn 
     38   PUBLIC   interpunb, interpvnb , interpub2b, interpvb2b 
    3939   PUBLIC   interpe3t, interpumsk, interpvmsk 
    40 # if defined key_zdftke 
    4140   PUBLIC   Agrif_tke, interpavm 
    42 # endif 
    4341 
    4442   INTEGER ::   bdy_tinterp = 0 
     
    4644#  include "vectopt_loop_substitute.h90" 
    4745   !!---------------------------------------------------------------------- 
    48    !! NEMO/NST 3.7 , NEMO Consortium (2015) 
     46   !! NEMO/NST 4.0 , NEMO Consortium (2017) 
    4947   !! $Id$ 
    5048   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     
    385383      !!                  ***  ROUTINE Agrif_dyn_ts  *** 
    386384      !!----------------------------------------------------------------------   
    387       !!  
    388385      INTEGER, INTENT(in) ::   jn 
    389386      !! 
     
    444441      !!                  ***  ROUTINE Agrif_dta_ts  *** 
    445442      !!----------------------------------------------------------------------   
    446       !!  
    447443      INTEGER, INTENT(in) ::   kt 
    448444      !! 
     
    504500      !!----------------------------------------------------------------------   
    505501      INTEGER, INTENT(in) ::   kt 
    506       !! 
    507502      !!----------------------------------------------------------------------   
    508503      ! 
     
    541536      !!----------------------------------------------------------------------   
    542537      ! 
    543       IF((nbondi == -1).OR.(nbondi == 2)) THEN 
     538      IF( nbondi == -1 .OR. nbondi == 2 ) THEN 
    544539         DO jj = 1, jpj 
    545540            ssha_e(2,jj) = hbdy_w(jj) 
     
    547542      ENDIF 
    548543      ! 
    549       IF((nbondi == 1).OR.(nbondi == 2)) THEN 
     544      IF( nbondi == 1 .OR. nbondi == 2 ) THEN 
    550545         DO jj = 1, jpj 
    551546            ssha_e(nlci-1,jj) = hbdy_e(jj) 
     
    553548      ENDIF 
    554549      ! 
    555       IF((nbondj == -1).OR.(nbondj == 2)) THEN 
     550      IF( nbondj == -1 .OR.(nbondj == 2 ) THEN 
    556551         DO ji = 1, jpi 
    557552            ssha_e(ji,2) = hbdy_s(ji) 
     
    559554      ENDIF 
    560555      ! 
    561       IF((nbondj == 1).OR.(nbondj == 2)) THEN 
     556      IF( nbondj == 1 .OR. nbondj == 2 ) THEN 
    562557         DO ji = 1, jpi 
    563558            ssha_e(ji,nlcj-1) = hbdy_n(ji) 
     
    567562   END SUBROUTINE Agrif_ssh_ts 
    568563 
    569 # if defined key_zdftke 
    570564 
    571565   SUBROUTINE Agrif_tke 
     
    579573      IF( zalpha > 1. )   zalpha = 1. 
    580574      ! 
    581       Agrif_SpecialValue    = 0.e0 
     575      Agrif_SpecialValue    = 0._wp 
    582576      Agrif_UseSpecialValue = .TRUE. 
    583577      ! 
    584       CALL Agrif_Bc_variable(avm_id ,calledweight=zalpha, procname=interpavm)        
     578      CALL Agrif_Bc_variable( avm_id , calledweight=zalpha, procname=interpavm )        
    585579      ! 
    586580      Agrif_UseSpecialValue = .FALSE. 
    587581      ! 
    588582   END SUBROUTINE Agrif_tke 
    589     
    590 # endif 
     583 
    591584 
    592585   SUBROUTINE interptsn( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before, nb, ndir ) 
    593586      !!---------------------------------------------------------------------- 
    594       !!   *** ROUTINE interptsn *** 
     587      !!                  *** ROUTINE interptsn *** 
    595588      !!---------------------------------------------------------------------- 
    596589      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) ::   ptab 
     
    599592      INTEGER                                     , INTENT(in   ) ::   nb , ndir 
    600593      ! 
    601       INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    602       INTEGER  ::   imin, imax, jmin, jmax 
    603       REAL(wp) ::   zrhox , zalpha1, zalpha2, zalpha3 
    604       REAL(wp) ::   zalpha4, zalpha5, zalpha6, zalpha7 
    605       LOGICAL  ::   western_side, eastern_side,northern_side,southern_side 
     594      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices 
     595      INTEGER ::   imin, imax, jmin, jmax 
     596      REAL(wp)::   zrhox , zalpha1, zalpha2, zalpha3 
     597      REAL(wp)::   zalpha4, zalpha5, zalpha6, zalpha7 
     598      LOGICAL ::   western_side, eastern_side,northern_side,southern_side 
    606599      !!---------------------------------------------------------------------- 
    607600      ! 
     
    770763   SUBROUTINE interpun( ptab, i1, i2, j1, j2, k1, k2, before ) 
    771764      !!---------------------------------------------------------------------- 
    772       !!   *** ROUTINE interpun *** 
     765      !!                         *** ROUTINE interpun *** 
    773766      !!---------------------------------------------------------------------- 
    774767      INTEGER                               , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2 
     
    776769      LOGICAL                               , INTENT(in   ) ::   before 
    777770      ! 
    778       INTEGER  ::   ji, jj, jk 
    779       REAL(wp) ::   zrhoy   
     771      INTEGER ::   ji, jj, jk 
     772      REAL(wp)::   zrhoy    
    780773      !!---------------------------------------------------------------------- 
    781774      ! 
     
    798791   SUBROUTINE interpvn( ptab, i1, i2, j1, j2, k1, k2, before ) 
    799792      !!---------------------------------------------------------------------- 
    800       !!   *** ROUTINE interpvn *** 
     793      !!                      *** ROUTINE interpvn *** 
    801794      !!---------------------------------------------------------------------- 
    802795      INTEGER                               , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2 
     
    804797      LOGICAL                               , INTENT(in   ) ::   before 
    805798      ! 
    806       INTEGER  ::   ji, jj, jk 
    807       REAL(wp) ::   zrhox   
     799      INTEGER ::   ji, jj, jk 
     800      REAL(wp)::   zrhox    
    808801      !!---------------------------------------------------------------------- 
    809802      !       
     
    831824      INTEGER                         , INTENT(in   ) ::   nb , ndir 
    832825      ! 
    833       INTEGER  ::   ji, jj 
    834       REAL(wp) ::   zrhoy, zrhot, zt0, zt1, ztcoeff 
    835       LOGICAL  ::   western_side, eastern_side,northern_side,southern_side 
     826      INTEGER ::   ji, jj 
     827      REAL(wp)::   zrhoy, zrhot, zt0, zt1, ztcoeff 
     828      LOGICAL ::   western_side, eastern_side,northern_side,southern_side 
    836829      !!----------------------------------------------------------------------   
    837830      ! 
     
    901894      INTEGER                         , INTENT(in   ) ::   nb , ndir 
    902895      ! 
    903       INTEGER  ::   ji,jj 
    904       REAL(wp) ::   zrhox, zrhot, zt0, zt1, ztcoeff    
    905       LOGICAL  ::   western_side, eastern_side,northern_side,southern_side 
     896      INTEGER ::   ji,jj 
     897      REAL(wp)::   zrhox, zrhot, zt0, zt1, ztcoeff    
     898      LOGICAL ::   western_side, eastern_side,northern_side,southern_side 
    906899      !!----------------------------------------------------------------------   
    907900      !  
     
    919912         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot       
    920913         IF( bdy_tinterp == 1 ) THEN 
    921             ztcoeff = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        & 
    922                &               - zt0**2._wp * (       zt0 - 1._wp)        ) 
     914            ztcoeff = zrhot * (  zt1**2._wp * ( zt1 - 1._wp)        & 
     915               &               - zt0**2._wp * ( zt0 - 1._wp)        ) 
    923916         ELSEIF( bdy_tinterp == 2 ) THEN 
    924             ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp & 
    925                &               - zt0        * (       zt0 - 1._wp)**2._wp )  
     917            ztcoeff = zrhot * (  zt1        * ( zt1 - 1._wp)**2._wp & 
     918               &               - zt0        * ( zt0 - 1._wp)**2._wp )  
    926919         ELSE 
    927920            ztcoeff = 1 
     
    942935         !             
    943936         IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 
    944             IF(western_side) THEN 
    945                vbdy_w(j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i1,j1:j2))   & 
    946                      &                                  * vmask(i1,j1:j2,1) 
    947             ENDIF 
    948             IF(eastern_side) THEN 
    949                vbdy_e(j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i1,j1:j2))   & 
    950                      &                                  * vmask(i1,j1:j2,1) 
    951             ENDIF 
    952             IF(southern_side) THEN 
    953                vbdy_s(i1:i2) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j1))   & 
    954                      &                                  * vmask(i1:i2,j1,1) 
    955             ENDIF 
    956             IF(northern_side) THEN 
    957                vbdy_n(i1:i2) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1))   & 
    958                      &                                  * vmask(i1:i2,j1,1) 
     937            IF( western_side  )   vbdy_w(j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i1,j1:j2)) * vmask(i1,j1:j2,1) 
     938            IF( eastern_side  )   vbdy_e(j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i1,j1:j2)) * vmask(i1,j1:j2,1) 
     939            IF( southern_side )   vbdy_s(i1:i2) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j1)) * vmask(i1:i2,j1,1) 
     940            IF( northern_side )   vbdy_n(i1:i2) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1)) * vmask(i1:i2,j1,1) 
    959941            ENDIF 
    960942         ENDIF 
     
    973955      INTEGER                         , INTENT(in   ) ::   nb , ndir 
    974956      ! 
    975       INTEGER  ::   ji,jj 
    976       REAL(wp) ::   zrhot, zt0, zt1,zat 
    977       LOGICAL  ::   western_side, eastern_side,northern_side,southern_side 
     957      INTEGER ::   ji,jj 
     958      REAL(wp)::   zrhot, zt0, zt1,zat 
     959      LOGICAL ::   western_side, eastern_side,northern_side,southern_side 
    978960      !!----------------------------------------------------------------------   
    979961      IF( before ) THEN 
     
    10301012            &           - zt0**2._wp * (-2._wp*zt0 + 3._wp)    )  
    10311013         ! 
    1032          IF(western_side )   vbdy_w(j1:j2) = zat * ptab(i1,j1:j2)   
    1033          IF(eastern_side )   vbdy_e(j1:j2) = zat * ptab(i1,j1:j2)   
    1034          IF(southern_side)   vbdy_s(i1:i2) = zat * ptab(i1:i2,j1)  
    1035          IF(northern_side)   vbdy_n(i1:i2) = zat * ptab(i1:i2,j1)  
     1014         IF( western_side )   vbdy_w(j1:j2) = zat * ptab(i1,j1:j2)   
     1015         IF( eastern_side )   vbdy_e(j1:j2) = zat * ptab(i1,j1:j2)   
     1016         IF( southern_side )   vbdy_s(i1:i2) = zat * ptab(i1:i2,j1)  
     1017         IF( northern_side )   vbdy_n(i1:i2) = zat * ptab(i1:i2,j1)  
    10361018      ENDIF 
    10371019      !       
     
    10481030      INTEGER                              , INTENT(in   ) :: nb , ndir 
    10491031      ! 
    1050       INTEGER :: ji, jj, jk 
    1051       LOGICAL :: western_side, eastern_side, northern_side, southern_side 
    1052       REAL(wp) :: ztmpmsk       
     1032      INTEGER ::   ji, jj, jk 
     1033      LOGICAL ::   western_side, eastern_side, northern_side, southern_side 
     1034      REAL(wp)::  ztmpmsk       
    10531035      !!----------------------------------------------------------------------   
    10541036      !     
     
    10651047               DO ji = i1, i2 
    10661048                  ! Get velocity mask at boundary edge points: 
    1067                   IF( western_side )   ztmpmsk = umask(ji    ,jj    ,1) 
    1068                   IF( eastern_side )   ztmpmsk = umask(nlci-2,jj    ,1) 
    1069                   IF( northern_side)   ztmpmsk = vmask(ji    ,nlcj-2,1) 
    1070                   IF( southern_side)   ztmpmsk = vmask(ji    ,2     ,1) 
     1049                  IF( western_side  )   ztmpmsk = umask(ji    ,jj    ,1) 
     1050                  IF( eastern_side  )   ztmpmsk = umask(nlci-2,jj    ,1) 
     1051                  IF( northern_side )   ztmpmsk = vmask(ji    ,nlcj-2,1) 
     1052                  IF( southern_side )   ztmpmsk = vmask(ji    ,2     ,1) 
    10711053                  ! 
    10721054                  IF( ABS( ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk) )*ztmpmsk > 1.D-2) THEN 
     
    11411123      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab 
    11421124      LOGICAL                              , INTENT(in   ) ::   before 
    1143       INTEGER                              , INTENT(in   ) :: nb , ndir 
     1125      INTEGER                              , INTENT(in   ) ::   nb , ndir 
    11441126      ! 
    11451127      INTEGER ::   ji, jj, jk 
     
    11751157   END SUBROUTINE interpvmsk 
    11761158 
    1177 # if defined key_zdftke 
    11781159 
    11791160   SUBROUTINE interpavm( ptab, i1, i2, j1, j2, k1, k2, before ) 
     
    11861167      !!----------------------------------------------------------------------   
    11871168      !       
    1188       IF( before ) THEN 
    1189          ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2) 
    1190       ELSE 
    1191          avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 
     1169      IF( before ) THEN   ;   ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2) 
     1170      ELSE                ;   avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 
    11921171      ENDIF 
    11931172      ! 
    11941173   END SUBROUTINE interpavm 
    1195  
    1196 # endif /* key_zdftke */ 
    11971174 
    11981175#else 
Note: See TracChangeset for help on using the changeset viewer.