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 8999 – NEMO

Changeset 8999


Ignore:
Timestamp:
2017-12-13T09:49:08+01:00 (7 years ago)
Author:
timgraham
Message:

Tidying of interp and added interpavm for vertical refinement case

File:
1 edited

Legend:

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

    r8998 r8999  
    873873      zrhoy = Agrif_rhoy() 
    874874      IF (before) THEN  
    875          !We can't use zero as the special value because we need to include zeros 
    876          !when interpolating the scale factors 
    877          IF(Agrif_UseSpecialValue) THEN  
    878 !             Agrif_SpecialValue = -999._wp 
    879              Agrif_SpecialValue = 0._wp 
    880          ELSE 
    881              Agrif_SpecialValue = 0._wp 
    882          ENDIF 
    883875         DO jk=1,jpk 
    884876            DO jj=j1,j2 
    885877               DO ji=i1,i2 
    886                   ptab(ji,jj,jk,1) = (e2u(ji,jj) * e3u_n(ji,jj,jk) * un(ji,jj,jk)*umask(ji,jj,jk)) - & 
    887                                    & ((umask(ji,jj,jk)-1) * Agrif_SpecialValue) 
     878                  ptab(ji,jj,jk,1) = (e2u(ji,jj) * e3u_n(ji,jj,jk) * un(ji,jj,jk)*umask(ji,jj,jk))  
    888879# if defined key_vertical 
    889880                  ptab(ji,jj,jk,2) = (umask(ji,jj,jk) * e2u(ji,jj) * e3u_n(ji,jj,jk)) 
     
    898889         western_side  = (nb == 1).AND.(ndir == 1) 
    899890         eastern_side  = (nb == 1).AND.(ndir == 2) 
    900  
    901          Agrif_SpecialValue = 0._wp ! reset specialvalue to zero now interpolation completed 
    902891 
    903892         DO ji=i1,i2 
     
    976965      !       
    977966      IF (before) THEN           
    978          IF(Agrif_UseSpecialValue) THEN  
    979 !             Agrif_SpecialValue = -999._wp 
    980              Agrif_SpecialValue = 0._wp 
    981          ELSE 
    982              Agrif_SpecialValue = 0._wp 
    983          ENDIF 
    984967         DO jk=k1,k2 
    985968            DO jj=j1,j2 
    986969               DO ji=i1,i2 
    987                   ptab(ji,jj,jk,1) = (e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk)*vmask(ji,jj,jk)) - & 
    988                                    & ((vmask(ji,jj,jk)-1) * Agrif_SpecialValue) 
     970                  ptab(ji,jj,jk,1) = (e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk)*vmask(ji,jj,jk)) 
    989971# if defined key_vertical 
    990972                  ptab(ji,jj,jk,2) = vmask(ji,jj,jk) * e1v(ji,jj) * e3v_n(ji,jj,jk) 
     
    996978         zrhox = Agrif_rhox() 
    997979# if defined key_vertical 
    998          Agrif_SpecialValue = 0._wp !Reset special value to zero now interpolation is done 
    999980 
    1000981         southern_side = (nb == 2).AND.(ndir == 1) 
     
    14031384# if defined key_zdftke || defined key_zdfgls 
    14041385 
    1405    SUBROUTINE interpavm( ptab, i1, i2, j1, j2, k1, k2, before ) 
     1386   SUBROUTINE interpavm( ptab, i1, i2, j1, j2, k1, k2, m1, m2, before ) 
    14061387      !!---------------------------------------------------------------------- 
    14071388      !!                  ***  ROUTINE interavm  *** 
    14081389      !!----------------------------------------------------------------------   
    1409       INTEGER                              , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2 
    1410       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab 
     1390      INTEGER                              , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2, m1, m2 
     1391      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,m1:m2), INTENT(inout) ::   ptab 
    14111392      LOGICAL                              , INTENT(in   ) ::   before 
     1393      REAL(wp), DIMENSION(k1:k2) :: tabin 
     1394      REAL(wp) :: h_in(k1:k2) 
     1395      REAL(wp) :: h_out(1:jpk) 
     1396      REAL(wp) :: zrhoxy 
     1397      INTEGER  :: N_in, N_out, ji, jj, jk 
    14121398      !!----------------------------------------------------------------------   
    14131399      !       
    1414       IF( before ) THEN 
    1415          ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2) 
    1416       ELSE 
    1417          avm  (i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 
     1400      zrhoxy = Agrif_rhox()*Agrif_rhoy() 
     1401      IF (before) THEN          
     1402         DO jk=k1,k2 
     1403            DO jj=j1,j2 
     1404              DO ji=i1,i2 
     1405                    ptab(ji,jj,jk,1) = avm_k(ji,jj,jk) 
     1406              END DO 
     1407           END DO 
     1408        END DO 
     1409#ifdef key_vertical          
     1410        DO jk=k1,k2 
     1411           DO jj=j1,j2 
     1412              DO ji=i1,i2 
     1413                 ptab(ji,jj,jk,2) = wmask(ji,jj,jk) * e1e2t(ji,jj) * e3w_n(ji,jj,jk)  
     1414              END DO 
     1415           END DO 
     1416        END DO 
     1417#else 
     1418      ptab(i1:i2,j1:j2,k1:k2,2) = 0._wp 
     1419#endif 
     1420      ELSE  
     1421#ifdef key_vertical          
     1422         avm_k(i1:i2,j1:j2,1:jpk) = 0. 
     1423         DO jj=j1,j2 
     1424            DO ji=i1,i2 
     1425               N_in = 0 
     1426               DO jk=k1,k2 !k2 = jpk of parent grid 
     1427                  IF (ptab(ji,jj,jk,2) == 0) EXIT 
     1428                  N_in = N_in + 1 
     1429                  tabin(jk) = ptab(ji,jj,jk,1) 
     1430                  h_in(N_in) = ptab(ji,jj,jk,2)/(e1e2t(ji,jj)*zrhoxy) 
     1431               END DO 
     1432               N_out = 0 
     1433               DO jk=1,jpk ! jpk of child grid 
     1434                  IF (wmask(ji,jj,jk) == 0) EXIT  
     1435                  N_out = N_out + 1 
     1436                  h_out(jk) = e3t_n(ji,jj,jk) 
     1437               ENDDO 
     1438               IF (N_in > 0) THEN 
     1439                  CALL reconstructandremap(tabin(1:N_in),h_in,avm_k(ji,jj,1:N_out),h_out,N_in,N_out) 
     1440               ENDIF 
     1441            ENDDO 
     1442         ENDDO 
     1443#else 
     1444         avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2,1) 
     1445#endif 
    14181446      ENDIF 
    14191447      ! 
Note: See TracChangeset for help on using the changeset viewer.