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 13220 for NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/NST/agrif_oce_sponge.F90 – NEMO

Ignore:
Timestamp:
2020-07-02T13:02:36+02:00 (4 years ago)
Author:
orioltp
Message:

dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation: updating from trunk r13218

Location:
NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation

    • Property svn:externals
      •  

        old new  
        22^/utils/build/makenemo@HEAD   makenemo 
        33^/utils/build/mk@HEAD         mk 
        4 ^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         4^/utils/tools/@HEAD           tools 
         5^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
  • NEMO/branches/2020/dev_r12512_HPC-04_mcastril_Mixed_Precision_implementation/src/NST/agrif_oce_sponge.F90

    r12546 r13220  
    8080      Agrif_SpecialValue=0. 
    8181      Agrif_UseSpecialValue = ln_spc_dyn 
     82      use_sign_north = .TRUE. 
     83      sign_north = -1. 
    8284      ! 
    8385      tabspongedone_u = .FALSE. 
     
    9092      ! 
    9193      Agrif_UseSpecialValue = .FALSE. 
     94      use_sign_north = .FALSE. 
    9295#endif 
    9396      ! 
     
    127130 
    128131         ! --- West --- ! 
    129          ztabramp(:,:) = 0._wp 
    130          ind1 = 1+nbghostcells 
    131          DO ji = mi0(ind1), mi1(ind1)                 
    132             ztabramp(ji,:) = ssumask(ji,:) 
    133          END DO 
    134          ! 
    135          zmskwest(:) = 0._wp 
    136          zmskwest(1:jpj) = MAXVAL(ztabramp(:,:), dim=1) 
     132         IF( lk_west) THEN 
     133            ztabramp(:,:) = 0._wp 
     134            ind1 = 1+nbghostcells 
     135            DO ji = mi0(ind1), mi1(ind1)                 
     136               ztabramp(ji,:) = ssumask(ji,:) 
     137            END DO 
     138            ! 
     139            zmskwest(:) = 0._wp 
     140            zmskwest(1:jpj) = MAXVAL(ztabramp(:,:), dim=1) 
     141         ENDIF 
    137142 
    138143         ! --- East --- ! 
    139          ztabramp(:,:) = 0._wp 
    140          ind1 = jpiglo - nbghostcells - 1 
    141          DO ji = mi0(ind1), mi1(ind1)                  
    142             ztabramp(ji,:) = ssumask(ji,:) 
    143          END DO 
    144          ! 
    145          zmskeast(:) = 0._wp 
    146          zmskeast(1:jpj) = MAXVAL(ztabramp(:,:), dim=1) 
     144         IF( lk_east ) THEN 
     145            ztabramp(:,:) = 0._wp 
     146            ind1 = jpiglo - nbghostcells - 1 
     147            DO ji = mi0(ind1), mi1(ind1)                  
     148               ztabramp(ji,:) = ssumask(ji,:) 
     149            END DO 
     150            ! 
     151            zmskeast(:) = 0._wp 
     152            zmskeast(1:jpj) = MAXVAL(ztabramp(:,:), dim=1) 
     153         ENDIF 
    147154 
    148155         ! --- South --- ! 
    149          ztabramp(:,:) = 0._wp 
    150          ind1 = 1+nbghostcells 
    151          DO jj = mj0(ind1), mj1(ind1)                  
    152             ztabramp(:,jj) = ssvmask(:,jj) 
    153          END DO 
    154          ! 
    155          zmsksouth(:) = 0._wp 
    156          zmsksouth(1:jpi) = MAXVAL(ztabramp(:,:), dim=2) 
     156         IF( lk_south ) THEN 
     157            ztabramp(:,:) = 0._wp 
     158            ind1 = 1+nbghostcells 
     159            DO jj = mj0(ind1), mj1(ind1)                  
     160               ztabramp(:,jj) = ssvmask(:,jj) 
     161            END DO 
     162            ! 
     163            zmsksouth(:) = 0._wp 
     164            zmsksouth(1:jpi) = MAXVAL(ztabramp(:,:), dim=2) 
     165         ENDIF 
    157166 
    158167         ! --- North --- ! 
    159          ztabramp(:,:) = 0._wp 
    160          ind1 = jpjglo - nbghostcells - 1 
    161          DO jj = mj0(ind1), mj1(ind1)                  
    162             ztabramp(:,jj) = ssvmask(:,jj) 
    163          END DO 
    164          ! 
    165          zmsknorth(:) = 0._wp 
    166          zmsknorth(1:jpi) = MAXVAL(ztabramp(:,:), dim=2) 
     168         IF( lk_north) THEN 
     169            ztabramp(:,:) = 0._wp 
     170            ind1 = jpjglo - nbghostcells - 1 
     171            DO jj = mj0(ind1), mj1(ind1)                  
     172               ztabramp(:,jj) = ssvmask(:,jj) 
     173            END DO 
     174            ! 
     175            zmsknorth(:) = 0._wp 
     176            zmsknorth(1:jpi) = MAXVAL(ztabramp(:,:), dim=2) 
     177         ENDIF 
     178 
    167179         ! JC: SPONGE MASKING TO BE SORTED OUT: 
    168180         zmskwest(:)  = 1._wp 
     
    192204 
    193205         ! --- West --- ! 
    194          ind1 = 1+nbghostcells 
    195          ind2 = 1+nbghostcells + ispongearea  
    196          DO ji = mi0(ind1), mi1(ind2)    
    197             DO jj = 1, jpj                
    198                ztabramp(ji,jj) = REAL( ind2 - mig(ji) ) * z1_ispongearea * zmskwest(jj) 
    199             END DO 
    200          END DO 
    201  
    202          ! ghost cells: 
    203          ind1 = 1 
    204          ind2 = nbghostcells + 1 
    205          DO ji = mi0(ind1), mi1(ind2)    
    206             DO jj = 1, jpj                
    207                ztabramp(ji,jj) = zmskwest(jj) 
    208             END DO 
    209          END DO 
     206         IF(lk_west) THEN 
     207            ind1 = 1+nbghostcells 
     208            ind2 = 1+nbghostcells + ispongearea  
     209            DO ji = mi0(ind1), mi1(ind2)    
     210               DO jj = 1, jpj                
     211                  ztabramp(ji,jj) = REAL( ind2 - mig(ji) ) * z1_ispongearea * zmskwest(jj) 
     212               END DO 
     213            END DO          
     214 
     215            ! ghost cells: 
     216            ind1 = 1 
     217            ind2 = nbghostcells + 1 
     218            DO ji = mi0(ind1), mi1(ind2)    
     219               DO jj = 1, jpj                
     220                  ztabramp(ji,jj) = zmskwest(jj) 
     221               END DO 
     222            END DO 
     223         ENDIF 
    210224 
    211225         ! --- East --- ! 
    212          ind1 = jpiglo - nbghostcells - ispongearea 
    213          ind2 = jpiglo - nbghostcells 
    214          DO ji = mi0(ind1), mi1(ind2) 
    215             DO jj = 1, jpj 
    216                ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mig(ji) - ind1 ) * z1_ispongearea) * zmskeast(jj) 
    217             ENDDO 
    218          END DO 
    219  
    220          ! ghost cells: 
    221          ind1 = jpiglo - nbghostcells 
    222          ind2 = jpiglo 
    223          DO ji = mi0(ind1), mi1(ind2) 
    224             DO jj = 1, jpj 
    225                ztabramp(ji,jj) = zmskeast(jj) 
    226             ENDDO 
    227          END DO 
     226         IF(lk_east) THEN 
     227            ind1 = jpiglo - nbghostcells - ispongearea 
     228            ind2 = jpiglo - nbghostcells 
     229            DO ji = mi0(ind1), mi1(ind2) 
     230 
     231               DO jj = 1, jpj 
     232                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mig(ji) - ind1 ) * z1_ispongearea) * zmskeast(jj) 
     233               ENDDO 
     234            END DO 
     235 
     236            ! ghost cells: 
     237            ind1 = jpiglo - nbghostcells 
     238            ind2 = jpiglo 
     239            DO ji = mi0(ind1), mi1(ind2) 
     240 
     241               DO jj = 1, jpj 
     242                  ztabramp(ji,jj) = zmskeast(jj) 
     243               ENDDO 
     244            END DO 
     245         ENDIF 
    228246 
    229247         ! --- South --- ! 
    230          ind1 = 1+nbghostcells 
    231          ind2 = 1+nbghostcells + jspongearea 
    232          DO jj = mj0(ind1), mj1(ind2)  
    233             DO ji = 1, jpi 
    234                ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - mjg(jj) ) * z1_jspongearea) * zmsksouth(ji) 
    235             END DO 
    236          END DO 
    237  
    238          ! ghost cells: 
    239          ind1 = 1 
    240          ind2 = nbghostcells + 1 
    241          DO jj = mj0(ind1), mj1(ind2)  
    242             DO ji = 1, jpi 
    243                ztabramp(ji,jj) = zmsksouth(ji) 
    244             END DO 
    245          END DO 
     248         IF( lk_south ) THEN  
     249            ind1 = 1+nbghostcells 
     250            ind2 = 1+nbghostcells + jspongearea 
     251            DO jj = mj0(ind1), mj1(ind2)  
     252               DO ji = 1, jpi 
     253                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - mjg(jj) ) * z1_jspongearea) * zmsksouth(ji) 
     254               END DO 
     255            END DO 
     256 
     257            ! ghost cells: 
     258            ind1 = 1 
     259            ind2 = nbghostcells + 1 
     260            DO jj = mj0(ind1), mj1(ind2)  
     261               DO ji = 1, jpi 
     262                  ztabramp(ji,jj) = zmsksouth(ji) 
     263               END DO 
     264            END DO 
     265         ENDIF 
    246266 
    247267         ! --- North --- ! 
    248          ind1 = jpjglo - nbghostcells - jspongearea 
    249          ind2 = jpjglo - nbghostcells 
    250          DO jj = mj0(ind1), mj1(ind2) 
    251             DO ji = 1, jpi 
    252                ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mjg(jj) - ind1 ) * z1_jspongearea) * zmsknorth(ji) 
    253             END DO 
    254          END DO 
    255  
    256          ! ghost cells: 
    257          ind1 = jpjglo - nbghostcells 
    258          ind2 = jpjglo 
    259          DO jj = mj0(ind1), mj1(ind2) 
    260             DO ji = 1, jpi 
    261                ztabramp(ji,jj) = zmsknorth(ji) 
    262             END DO 
    263          END DO 
    264  
     268         IF( lk_north ) THEN   
     269            ind1 = jpjglo - nbghostcells - jspongearea 
     270            ind2 = jpjglo - nbghostcells 
     271            DO jj = mj0(ind1), mj1(ind2) 
     272               DO ji = 1, jpi 
     273                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mjg(jj) - ind1 ) * z1_jspongearea) * zmsknorth(ji) 
     274               END DO 
     275            END DO 
     276 
     277            ! ghost cells: 
     278            ind1 = jpjglo - nbghostcells 
     279            ind2 = jpjglo 
     280            DO jj = mj0(ind1), mj1(ind2) 
     281               DO ji = 1, jpi 
     282                  ztabramp(ji,jj) = zmsknorth(ji) 
     283               END DO 
     284            END DO 
     285         ENDIF 
     286       
    265287      ENDIF 
    266288 
     
    334356      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    335357      INTEGER  ::   iku, ikv 
    336       REAL(wp) :: ztsa, zabe1, zabe2, zbtr, zhtot, ztrelax 
     358      REAL(wp) :: ztsa, zabe1, zabe2, zbtr, zhtot 
    337359      REAL(wp), DIMENSION(i1:i2,j1:j2,jpk) :: ztu, ztv 
    338360      REAL(wp), DIMENSION(i1:i2,j1:j2,jpk,n1:n2) ::tsbdiff 
     
    438460         ENDDO 
    439461 
    440          !* set relaxation time scale 
    441          IF( l_1st_euler .AND. lk_agrif_fstep ) THEN   ;   ztrelax =   rn_trelax_tra  / (        rn_Dt ) 
    442          ELSE                                          ;   ztrelax =   rn_trelax_tra  / (2._wp * rn_Dt ) 
    443          ENDIF 
    444  
    445462         DO jn = 1, jpts             
    446463            DO jk = 1, jpkm1 
     
    448465               DO jj = j1,j2 
    449466                  DO ji = i1,i2-1 
    450                      zabe1 = rn_sponge_tra * fspu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm_a) 
     467                     zabe1 = rn_sponge_tra * r1_Dt * fspu(ji,jj) * umask(ji,jj,jk) * e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a) 
    451468                     ztu(ji,jj,jk) = zabe1 * ( tsbdiff(ji+1,jj  ,jk,jn) - tsbdiff(ji,jj,jk,jn) )  
    452469                  END DO 
     
    455472               DO ji = i1,i2 
    456473                  DO jj = j1,j2-1 
    457                      zabe2 = rn_sponge_tra * fspv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm_a) 
     474                     zabe2 = rn_sponge_tra * r1_Dt * fspv(ji,jj) * vmask(ji,jj,jk) * e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm_a) 
    458475                     ztv(ji,jj,jk) = zabe2 * ( tsbdiff(ji  ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 
    459476                  END DO 
     
    480497                        ! horizontal diffusive trends 
    481498                        ztsa = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) & 
    482                              &  - ztrelax * fspt(ji,jj) * tsbdiff(ji,jj,jk,jn)  
     499                             &  - rn_trelax_tra * r1_Dt * fspt(ji,jj) * tsbdiff(ji,jj,jk,jn)  
    483500                        ! add it to the general tracer trends 
    484501                        ts(ji,jj,jk,jn,Krhs_a) = ts(ji,jj,jk,jn,Krhs_a) + ztsa 
     
    507524 
    508525      ! sponge parameters  
    509       REAL(wp) :: ze2u, ze1v, zua, zva, zbtr, zhtot, ztrelax 
     526      REAL(wp) :: ze2u, ze1v, zua, zva, zbtr, zhtot 
    510527      REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: ubdiff 
    511528      REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: rotdiff, hdivdiff 
     
    595612         ubdiff(i1:i2,j1:j2,:) = (uu(i1:i2,j1:j2,:,Kbb_a) - tabres(i1:i2,j1:j2,:,1))*umask(i1:i2,j1:j2,:) 
    596613#endif 
    597          !* set relaxation time scale 
    598          IF( l_1st_euler .AND. lk_agrif_fstep ) THEN   ;   ztrelax =   rn_trelax_dyn  / (        rn_Dt ) 
    599          ELSE                                          ;   ztrelax =   rn_trelax_dyn  / (2._wp * rn_Dt ) 
    600          ENDIF 
    601614         ! 
    602615         DO jk = 1, jpkm1                                 ! Horizontal slab 
     
    608621            DO jj = j1,j2 
    609622               DO ji = i1+1,i2   ! vector opt. 
    610                   zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kbb_a) * rn_sponge_dyn * fspt(ji,jj) 
     623                  zbtr = rn_sponge_dyn * r1_Dt * fspt(ji,jj) / e3t(ji,jj,jk,Kbb_a) 
    611624                  hdivdiff(ji,jj,jk) = (  e2u(ji  ,jj)*e3u(ji  ,jj,jk,Kbb_a) * ubdiff(ji  ,jj,jk) & 
    612625                                     &   -e2u(ji-1,jj)*e3u(ji-1,jj,jk,Kbb_a) * ubdiff(ji-1,jj,jk) ) * zbtr 
     
    616629            DO jj = j1,j2-1 
    617630               DO ji = i1,i2   ! vector opt. 
    618                   zbtr = r1_e1e2f(ji,jj) * e3f(ji,jj,jk) * rn_sponge_dyn * fspf(ji,jj) 
     631                  zbtr = rn_sponge_dyn * r1_Dt * fspf(ji,jj) * e3f(ji,jj,jk)  
    619632                  rotdiff(ji,jj,jk) = ( -e1u(ji,jj+1) * ubdiff(ji,jj+1,jk)   & 
    620633                                    &   +e1u(ji,jj  ) * ubdiff(ji,jj  ,jk) ) * fmask(ji,jj,jk) * zbtr  
     
    633646                     zua = - ( ze2u - rotdiff (ji,jj-1,jk) ) / ( e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a) )   & 
    634647                         & + ( hdivdiff(ji+1,jj,jk) - ze1v ) * r1_e1u(ji,jj) &  
    635                          & - ztrelax * fspu(ji,jj) * ubdiff(ji,jj,jk) 
     648                         & - rn_trelax_dyn * r1_Dt * fspu(ji,jj) * ubdiff(ji,jj,jk) 
    636649 
    637650                     ! add it to the general momentum trends 
     
    646659 
    647660         jmax = j2-1 
     661        ! IF (lk_north) jmax = MIN(jmax,nlcj-nbghostcells-2)   ! North 
    648662         IF ((nbondj == 1).OR.(nbondj == 2)) jmax = MIN(jmax,nlcj-nbghostcells-2)   ! North 
    649663 
     
    684698      ! 
    685699      INTEGER  ::   ji, jj, jk, imax 
    686       REAL(wp) ::   ze2u, ze1v, zua, zva, zbtr, zhtot, ztrelax 
     700      REAL(wp) ::   ze2u, ze1v, zua, zva, zbtr, zhtot 
    687701      REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: vbdiff 
    688702      REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: rotdiff, hdivdiff 
     
    771785         vbdiff(i1:i2,j1:j2,:) = (vv(i1:i2,j1:j2,:,Kbb_a) - tabres(i1:i2,j1:j2,:,1))*vmask(i1:i2,j1:j2,:) 
    772786# endif 
    773          !* set relaxation time scale 
    774          IF( l_1st_euler .AND. lk_agrif_fstep ) THEN   ;   ztrelax =   rn_trelax_dyn  / (        rn_Dt ) 
    775          ELSE                                          ;   ztrelax =   rn_trelax_dyn  / (2._wp * rn_Dt ) 
    776          ENDIF 
    777787         ! 
    778788         DO jk = 1, jpkm1                                 ! Horizontal slab 
     
    784794            DO jj = j1+1,j2 
    785795               DO ji = i1,i2   ! vector opt. 
    786                   zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kbb_a) * rn_sponge_dyn * fspt(ji,jj) 
     796                  zbtr = rn_sponge_dyn * r1_Dt * fspt(ji,jj) / e3t(ji,jj,jk,Kbb_a) 
    787797                  hdivdiff(ji,jj,jk) = ( e1v(ji,jj  ) * e3v(ji,jj  ,jk,Kbb_a) * vbdiff(ji,jj  ,jk)  & 
    788798                                     &  -e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kbb_a) * vbdiff(ji,jj-1,jk)  ) * zbtr 
     
    791801            DO jj = j1,j2 
    792802               DO ji = i1,i2-1   ! vector opt. 
    793                   zbtr = r1_e1e2f(ji,jj) * e3f(ji,jj,jk) * rn_sponge_dyn * fspf(ji,jj) 
     803                  zbtr = rn_sponge_dyn * r1_Dt * fspf(ji,jj) * e3f(ji,jj,jk)  
    794804                  rotdiff(ji,jj,jk) = ( e2v(ji+1,jj) * vbdiff(ji+1,jj,jk) &  
    795805                                    &  -e2v(ji  ,jj) * vbdiff(ji  ,jj,jk)  ) * fmask(ji,jj,jk) * zbtr 
     
    802812 
    803813         imax = i2 - 1 
     814      !   IF(lk_east) imax = MIN(imax,nlci-nbghostcells-2)   ! East 
    804815         IF ((nbondi == 1).OR.(nbondi == 2))   imax = MIN(imax,nlci-nbghostcells-2)   ! East 
    805816 
     
    808819               IF( .NOT. tabspongedone_u(ji,jj) ) THEN 
    809820                  DO jk = 1, jpkm1 
    810                      uu(ji,jj,jk,Krhs_a) = uu(ji,jj,jk,Krhs_a)                                                               & 
     821                     uu(ji,jj,jk,Krhs_a) = uu(ji,jj,jk,Krhs_a)                                                     & 
    811822                        & - ( rotdiff (ji  ,jj,jk) - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a) )  & 
    812823                        & + ( hdivdiff(ji+1,jj,jk) - hdivdiff(ji,jj  ,jk)) * r1_e1u(ji,jj) 
     
    822833               IF( .NOT. tabspongedone_v(ji,jj) ) THEN 
    823834                  DO jk = 1, jpkm1 
    824                      vv(ji,jj,jk,Krhs_a) = vv(ji,jj,jk,Krhs_a)                                                                  & 
     835                     vv(ji,jj,jk,Krhs_a) = vv(ji,jj,jk,Krhs_a)                                                        & 
    825836                        &  + ( rotdiff (ji,jj  ,jk) - rotdiff (ji-1,jj,jk) ) / ( e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) )   & 
    826                         &  + ( hdivdiff(ji,jj+1,jk) - hdivdiff(ji  ,jj,jk) ) * r1_e2v(ji,jj)                      & 
    827                         &  - ztrelax * fspv(ji,jj) * vbdiff(ji,jj,jk) 
     837                        &  + ( hdivdiff(ji,jj+1,jk) - hdivdiff(ji  ,jj,jk) ) * r1_e2v(ji,jj)                          & 
     838                        &  - rn_trelax_dyn * r1_Dt * fspv(ji,jj) * vbdiff(ji,jj,jk) 
    828839                  END DO 
    829840               ENDIF 
Note: See TracChangeset for help on using the changeset viewer.