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 10251 for branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/NESTING/src/agrif_connect_topo.f90 – NEMO

Ignore:
Timestamp:
2018-10-29T15:20:26+01:00 (5 years ago)
Author:
kingr
Message:

Rolled back to r10247 - i.e., undid merge of pkg br and 3.6_stable br

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/NESTING/src/agrif_connect_topo.f90

    r10248 r10251  
    105105    IMPLICIT NONE 
    106106    ! 
    107     REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zmin,zmax 
     107    REAL*8 :: za1,za0,zsur,zacr,zkth,zmin,zmax 
    108108    TYPE(Coordinates) :: Grid 
    109109    INTEGER :: i,j 
     
    134134       za0  = pa0 
    135135       za1  = pa1 
    136        za2  = pa2 
    137136       ! 
    138137    ELSE 
     
    148147 
    149148    zacr = ppacr 
    150     zkth = ppkth 
    151     zacr2 = ppacr2 
    152     zkth2 = ppkth2    
     149    zkth = ppkth  
     150 
    153151    ! 
    154152    ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N)) 
    155153    ! 
    156     IF( ppkth == 0. ) THEN            !  uniform vertical grid  
    157        za1 = pphmax / FLOAT(N-1)  
    158        DO i = 1, N 
    159           gdepw(i) = ( i - 1   ) * za1 
    160           gdept(i) = ( i - 0.5 ) * za1 
    161           e3w  (i) =  za1 
    162           e3t  (i) =  za1 
    163        END DO 
    164     ELSE                            ! Madec & Imbard 1996 function 
    165        IF( .NOT. ldbletanh ) THEN 
    166           DO i = 1,N 
    167              !  
    168              gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr)))  
    169              gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr))) 
    170              e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr)) 
    171              e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 
    172              ! 
    173           END DO 
    174        ELSE 
    175           DO i = 1,N 
    176              ! Double tanh function 
    177              gdepw(i) = ( zsur + za0*i  + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr  ) )               & 
    178                 &                       + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) )  ) 
    179              gdept(i) = ( zsur + za0*(i+0.5) + za1 * zacr * LOG ( COSH( ((i+0.5)-zkth ) / zacr  ) )    & 
    180                 &                            + za2 * zacr2* LOG ( COSH( ((i+0.5)-zkth2) / zacr2 ) )  ) 
    181              e3w  (i) =          za0         + za1        * TANH(       (i-zkth ) / zacr  )            & 
    182                 &                            + za2        * TANH(       (i-zkth2) / zacr2 ) 
    183              e3t  (i) =          za0         + za1        * TANH(       ((i+0.5)-zkth ) / zacr  )      & 
    184                 &                            + za2        * TANH(       ((i+0.5)-zkth2) / zacr2 ) 
    185             END DO 
    186        ENDIF 
    187     ENDIF 
     154    DO i = 1,N 
     155       gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr)))  
     156       gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr))) 
     157       e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr)) 
     158       e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 
     159    END DO 
    188160    ! 
    189161    gdepw(1) = 0.0 
    190162    zmax = gdepw(N) + e3t(N) 
    191     IF( rn_hmin < 0. ) THEN  ;   i = - INT( rn_hmin )                                  ! from a nb of level 
    192     ELSE                     ;   i = MINLOC( gdepw, mask = gdepw > rn_hmin, dim = 1 )  ! from a depth 
    193     ENDIF 
    194     zmin = gdepw(i+1) 
     163    zmin = gdepw(4) 
    195164    ! 
    196165    IF ( .NOT. ASSOCIATED(Grid%bathy_level)) & 
     
    258227    IMPLICIT NONE 
    259228    ! 
    260     REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zmin,zmax 
     229    REAL*8 :: za1,za0,zsur,zacr,zkth,zmin,zmax 
    261230    TYPE(Coordinates) :: Grid 
    262231    INTEGER :: i,j 
     
    288257       za0  = pa0 
    289258       za1  = pa1 
    290        za2  = pa2 
    291259       ! 
    292260    ELSE 
     
    296264       WRITE(*,*) 'please check values of variables' 
    297265       WRITE(*,*) 'in namelist vertical_grid section' 
    298        WRITE(*,*) ' '  
    299        STOP      
     266       WRITE(*,*) ' ' 
     267       STOP       
    300268       !        
    301269    ENDIF 
    302  
     270    ! 
    303271    zacr = ppacr 
    304     zkth = ppkth 
    305     zacr2 = ppacr2 
    306     zkth2 = ppkth2    
     272    zkth = ppkth  
     273 
    307274    ! 
    308275    ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N)) 
    309276    ! 
    310     IF( ppkth == 0. ) THEN            !  uniform vertical grid  
    311        za1 = pphmax / FLOAT(N-1)  
    312        DO i = 1, N 
    313           gdepw(i) = ( i - 1   ) * za1 
    314           gdept(i) = ( i - 0.5 ) * za1 
    315           e3w  (i) =  za1 
    316           e3t  (i) =  za1 
    317        END DO 
    318     ELSE                            ! Madec & Imbard 1996 function 
    319        IF( .NOT. ldbletanh ) THEN 
    320           DO i = 1,N 
    321              !  
    322              gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr)))  
    323              gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr))) 
    324              e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr)) 
    325              e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 
    326              ! 
    327           END DO 
    328        ELSE 
    329           DO i = 1,N 
    330              ! Double tanh function 
    331              gdepw(i) = ( zsur + za0*i  + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr  ) )               & 
    332                 &                       + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) )  ) 
    333              gdept(i) = ( zsur + za0*(i+0.5) + za1 * zacr * LOG ( COSH( ((i+0.5)-zkth ) / zacr  ) )    & 
    334                 &                            + za2 * zacr2* LOG ( COSH( ((i+0.5)-zkth2) / zacr2 ) )  ) 
    335              e3w  (i) =          za0         + za1        * TANH(       (i-zkth ) / zacr  )            & 
    336                 &                            + za2        * TANH(       (i-zkth2) / zacr2 ) 
    337              e3t  (i) =          za0         + za1        * TANH(       ((i+0.5)-zkth ) / zacr  )      & 
    338                 &                            + za2        * TANH(       ((i+0.5)-zkth2) / zacr2 ) 
    339          END DO 
    340        ENDIF 
    341     ENDIF 
     277    DO i = 1,N 
     278       !  
     279       gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr)))  
     280       gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr))) 
     281       e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr)) 
     282       e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 
     283    END DO 
    342284    ! 
    343285    gdepw(1) = 0.0   
     
    742684  ! for consistency with fine grid bathymetry         * 
    743685  !                        * 
    744   ! if a given coarse grid point is masked and one of the     * 
    745   ! child grid points contained in this coarse cell is not masked * 
    746   ! the corresponding coarse grid point is unmasked with rn_hmin * 
    747   ! value                            * 
     686  ! if a given coarse grid point is masked and one of the      * 
     687  ! child grid points contained in this coarse cell is not masked * 
     688  ! the corresponding coarse grid point is unmasked with gdepw(4) * 
     689  ! value                        * 
    748690  !                        * 
    749691  ! - input :                    * 
     
    762704    ! 
    763705    INTEGER :: ideb,jdeb,ifin,jfin 
    764     REAL*8 :: za2,za1,za0,zsur,zacr,zkth,zacr2,zkth2,zmin 
     706    REAL*8 :: za1,za0,zsur,zacr,zkth,zmin 
    765707    INTEGER :: i,j 
    766708    INTEGER :: k1 
     
    785727       za0  = pa0 
    786728       za1  = pa1 
    787        za2  = pa2 
    788729       ! 
    789730    ELSE 
     
    799740 
    800741    zacr = ppacr 
    801     zkth = ppkth 
    802     zacr2 = ppacr2 
    803     zkth2 = ppkth2    
     742    zkth = ppkth  
     743 
    804744    ! 
    805745    ALLOCATE(gdepw(N),gdept(N),e3w(N),e3t(N)) 
    806746    ! 
    807     IF( ppkth == 0. ) THEN            !  uniform vertical grid  
    808        za1 = pphmax / FLOAT(N-1)  
    809        DO i = 1, N 
    810           gdepw(i) = ( i - 1   ) * za1 
    811           gdept(i) = ( i - 0.5 ) * za1 
    812           e3w  (i) =  za1 
    813           e3t  (i) =  za1 
    814        END DO 
    815     ELSE                            ! Madec & Imbard 1996 function 
    816        IF( .NOT. ldbletanh ) THEN 
    817           DO i = 1,N 
    818              !  
    819              gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr)))  
    820              gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr))) 
    821              e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr)) 
    822              e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 
    823              ! 
    824           END DO 
    825        ELSE 
    826           DO i = 1,N 
    827              ! Double tanh function 
    828              gdepw(i) = ( zsur + za0*i  + za1 * zacr * LOG ( COSH( (i-zkth ) / zacr  ) )               & 
    829                 &                       + za2 * zacr2* LOG ( COSH( (i-zkth2) / zacr2 ) )  ) 
    830              gdept(i) = ( zsur + za0*(i+0.5) + za1 * zacr * LOG ( COSH( ((i+0.5)-zkth ) / zacr  ) )    & 
    831                 &                            + za2 * zacr2* LOG ( COSH( ((i+0.5)-zkth2) / zacr2 ) )  ) 
    832              e3w  (i) =          za0         + za1        * TANH(       (i-zkth ) / zacr  )            & 
    833                 &                            + za2        * TANH(       (i-zkth2) / zacr2 ) 
    834              e3t  (i) =          za0         + za1        * TANH(       ((i+0.5)-zkth ) / zacr  )      & 
    835                 &                            + za2        * TANH(       ((i+0.5)-zkth2) / zacr2 ) 
    836           END DO 
    837        ENDIF 
    838     ENDIF 
    839     ! 
    840     IF( rn_hmin < 0. ) THEN  ;   i = - INT( rn_hmin )                                  ! from a nb of level 
    841     ELSE                     ;   i = MINLOC( gdepw, mask = gdepw > rn_hmin, dim = 1 )  ! from a depth 
    842     ENDIF 
    843     zmin = gdepw(i+1) 
     747    DO i = 1,N 
     748       !  
     749       gdepw(i) = (zsur+za0*i+za1*zacr*LOG(COSH((i-zkth)/zacr)))  
     750       gdept(i) = (zsur+za0*(i+0.5)+za1*zacr*LOG(COSH(((i+0.5)-zkth)/zacr))) 
     751       e3w(i)   = (za0 + za1 * TANH((i-zkth)/zacr)) 
     752       e3t(i)   = (za0 + za1 * TANH(((i+0.5)-zkth)/zacr)) 
     753    END DO 
     754    ! 
     755    zmin = gdepw(4) 
    844756    !       
    845757    diff = 0 
Note: See TracChangeset for help on using the changeset viewer.