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

Changeset 8596


Ignore:
Timestamp:
2017-10-05T16:35:28+02:00 (7 years ago)
Author:
timgraham
Message:

Vertical refinement code working but protected by "key_vertical"

Location:
branches/2017/dev_r8126_UKMO_AGRIF_vert_interp/NEMOGCM/NEMO/NST_SRC
Files:
2 edited

Legend:

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

    r8135 r8596  
    617617 
    618618      zrhoxy = Agrif_rhox()*Agrif_rhoy() 
     619 
    619620      IF (before) THEN          
    620          DO jn = n1,n2-1 
     621            IF(Agrif_UseSpecialValue) THEN  
     622               Agrif_SpecialValue = -999._wp 
     623            ELSE 
     624               Agrif_SpecialValue = 0._wp 
     625            ENDIF 
     626            DO jn = n1,n2-1 
     627               DO jk=k1,k2 
     628                  DO jj=j1,j2 
     629                     DO ji=i1,i2 
     630                        ptab(ji,jj,jk,jn) = tsn(ji,jj,jk,jn) * e1e2t(ji,jj) * e3t_n(ji,jj,jk) * tmask(ji,jj,jk) - & 
     631                                          & (tmask(ji,jj,jk)-1) * Agrif_SpecialValue 
     632                     END DO 
     633                  END DO 
     634               END DO 
     635            END DO 
    621636            DO jk=k1,k2 
    622637               DO jj=j1,j2 
    623638                  DO ji=i1,i2 
    624                      ptab(ji,jj,jk,jn) = tsn(ji,jj,jk,jn) * e1e2t(ji,jj) * e3t_n(ji,jj,jk) 
     639                     ptab(ji,jj,jk,n2) = tmask(ji,jj,jk) * e1e2t(ji,jj) * e3t_n(ji,jj,jk)  
    625640                  END DO 
    626641               END DO 
    627642            END DO 
    628          END DO 
    629          DO jk=k1,k2 
    630             DO jj=j1,j2 
    631                DO ji=i1,i2 
    632                   ptab(ji,jj,jk,n2) = tmask(ji,jj,jk) * e1e2t(ji,jj) * e3t_n(ji,jj,jk)  
    633                END DO 
    634             END DO 
    635          END DO 
    636  
    637643      ELSE  
     644         Agrif_SpecialValue = 0._wp !reset now interpolation is done 
    638645! VERTICAL REFINEMENT BEGIN 
    639  
     646#ifdef key_vertical          
    640647         ptab_child(:,:,:,:) = 0. 
    641648         do jj=j1,j2 
     
    677684         enddo 
    678685         enddo 
     686#else 
     687         do jk=k1,k2 
     688            do jj=j1,j2 
     689               do ji=i1,i2 
     690                 ! This will be slow - Is there a way to speed it up and avoid divide by zero? 
     691                 IF (ptab(ji,jj,jk,n2) .NE. 0) THEN 
     692                    ptab_child(ji,jj,jk,n1:n2-1) = ptab(ji,jj,jk,n1:n2-1)/ptab(ji,jj,jk,n2) 
     693                 ELSE 
     694                    ptab_child(ji,jj,jk,n1:n2-1) = 0._wp 
     695                 ENDIF 
     696               enddo 
     697            enddo 
     698         enddo 
     699#endif 
    679700    
    680701 
     
    840861 
    841862 
    842    SUBROUTINE interpun( ptab, i1, i2, j1, j2, k1, k2, before ) 
     863   SUBROUTINE interpun( ptab, i1, i2, j1, j2, k1, k2, m1, m2, before, nb, ndir ) 
    843864      !!---------------------------------------------------------------------- 
    844865      !!   *** ROUTINE interpun *** 
     
    891912 
    892913         ptab_child(:,:,:) = 0. 
     914#ifdef key_vertical 
     915! VERTICAL REFINEMENT BEGIN 
    893916         DO jj=j1,j2 
    894917            DO ji=i1,i2 
     
    938961! remove division of ua by fs e3u (already done) and also zrhoy and e2u 
    939962! VERTICAL REFINEMENT END 
    940  
    941963         DO jk = 1, jpkm1 
    942964            DO jj=j1,j2 
    943965               ua(i1:i2,jj,jk) = ptab_child(i1:i2,jj,jk) 
    944 !/(zrhoy*e2u(i1:i2,jj))) 
    945             END DO 
    946          END DO 
     966            END DO 
     967         END DO 
     968#else 
     969         DO jk = 1, jpkm1 
     970            DO jj=j1,j2 
     971               ua(i1:i2,jj,jk) = umask(i1:i2,jj,jk) * ptab(i1:i2,jj,jk,1) / ( zrhoy * e2u(i1:i2,jj) * e3u_n(i1:i2,jj,jk) ) 
     972            END DO 
     973         END DO 
     974#endif 
    947975      ENDIF 
    948976      !  
     
    950978 
    951979 
    952    SUBROUTINE interpvn( ptab, i1, i2, j1, j2, k1, k2, before ) 
     980   SUBROUTINE interpvn( ptab, i1, i2, j1, j2, k1, k2, m1, m2, before, nb, ndir ) 
    953981      !!---------------------------------------------------------------------- 
    954982      !!   *** ROUTINE interpvn *** 
     
    9911019         END DO 
    9921020      ELSE         
     1021         Agrif_SpecialValue = 0._wp !Reset special value to zero now interpolation is done 
     1022         ptab_child(:,:,:) = 0. 
     1023#ifdef key_vertical 
    9931024! VERTICAL REFINEMENT BEGIN 
    994          ptab_child(:,:,:) = 0. 
    9951025         southern_side = (nb == 2).AND.(ndir == 1) 
    9961026         northern_side = (nb == 2).AND.(ndir == 2) 
    997  
    998          Agrif_SpecialValue = 0._wp !Reset special value to zero now interpolation is done 
    9991027 
    10001028         do jj=j1,j2 
     
    10411069! in the following 
    10421070! remove division of va by fs e3v, zrhox and e1v (already done) 
     1071            DO jk=1,jpkm1 
     1072               DO jj=j1,j2 
     1073                  va(i1:i2,jj,jk) = ptab_child(i1:i2,jj,jk) 
     1074               END DO 
     1075            END DO 
    10431076! VERTICAL REFINEMENT END 
    1044          DO jk=1,jpkm1 
    1045             DO jj=j1,j2 
    1046                va(i1:i2,jj,jk) = ptab_child(i1:i2,jj,jk) 
    1047             END DO 
    1048          END DO 
     1077#else  
     1078            DO jk=1,jpkm1 
     1079               va(i1:i2,j1:j2,jk) = vmask(i1:i2,j1:j2,jk) * ptab(i1:i2,j1:j2,jk,1) / & 
     1080                                    & ( zrhox * e1v(i1:i2,j1:j2) * e3v_n(i1:i2,j1:j2,jk) ) 
     1081            END DO 
     1082#endif  
    10491083      ENDIF 
    10501084      !         
  • branches/2017/dev_r8126_UKMO_AGRIF_vert_interp/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90

    r8135 r8596  
    199199      ! 
    200200      IF (before) THEN 
    201          zrho_xy = Agrif_rhox() * Agrif_rhoy()  
    202          DO jn = n1,n2-1 
     201# if defined key_vertical 
     202            zrho_xy = Agrif_rhox() * Agrif_rhoy()  
     203            DO jn = n1,n2-1 
     204               DO jk=k1,k2 
     205                  DO jj=j1,j2 
     206                     DO ji=i1,i2 
     207                        tabres(ji,jj,jk,jn) = zrho_xy * tsn(ji,jj,jk,jn) * e1e2t(ji,jj) * e3t_n(ji,jj,jk) 
     208                     END DO 
     209                  END DO 
     210               END DO 
     211            END DO 
    203212            DO jk=k1,k2 
    204213               DO jj=j1,j2 
    205214                  DO ji=i1,i2 
    206                      tabres(ji,jj,jk,jn) = zrho_xy * tsn(ji,jj,jk,jn) * e1e2t(ji,jj) * e3t_n(ji,jj,jk) 
     215                     tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * zrho_xy * e1e2t(ji,jj) * e3t_n(ji,jj,jk)  
    207216                  END DO 
    208217               END DO 
    209218            END DO 
    210          END DO 
    211          DO jk=k1,k2 
    212             DO jj=j1,j2 
    213                DO ji=i1,i2 
    214                   tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * zrho_xy * e1e2t(ji,jj) * e3t_n(ji,jj,jk)  
    215                END DO 
    216             END DO 
    217          END DO 
    218           
     219#else 
     220            DO jn = n1,n2-1 
     221               DO jk=k1,k2 
     222                  DO jj=j1,j2 
     223                     DO ji=i1,i2 
     224                        tabres(ji,jj,jk,jn) = tsn(ji,jj,jk,jn) 
     225                     END DO 
     226                  END DO 
     227               END DO 
     228            END DO         
     229#endif 
    219230      ELSE 
    220231! VERTICAL REFINEMENT BEGIN 
    221232         tabres_child(:,:,:,:) = 0. 
    222  
     233# if defined key_vertical 
    223234         DO jj=j1,j2 
    224235         DO ji=i1,i2 
     
    243254!               h_in(N_in) = h_diff 
    244255!               tabin(N_in,:) = tabin(N_in-1,:) 
    245              IF (h_diff < 0) THEN 
     256             IF (h_diff < -1.e-4) THEN 
    246257             print *,'CHECK YOUR bathy T points ...',ji,jj,h_diff,sum(h_in(1:N_in)),sum(h_out(1:N_out)) 
    247              print *,'Nval = ',N_out,mbathy(ji,jj) 
    248              print *,'BATHY = ',gdepw_0(ji,jj,mbathy(ji,jj)+1),sum(e3t_0(ji,jj,1:mbathy(ji,jj))) 
     258             print *, tabres(ji,j1:j2,1,n2) 
    249259             STOP 
    250260!               N_out = N_out + 1 
     
    257267         ENDDO 
    258268         ENDDO 
     269#else 
     270            tabres_child(:,:,:,:) = tabres(:,:,:,1:jpts) 
     271#endif 
    259272          
    260273! WARNING : 
     
    317330      IF( before ) THEN 
    318331         zrhoy = Agrif_Rhoy() 
     332# if defined key_vertical 
    319333         DO jk=k1,k2 
    320334            DO jj=j1,j2 
     
    325339            END DO 
    326340         END DO 
    327       ELSE 
     341#else 
     342            DO jk = k1,k2 
     343               tabres(i1:i2,j1:j2,jk,1) = zrhoy * e2u(i1:i2,j1:j2) * e3u_n(i1:i2,j1:j2,jk) * un(i1:i2,j1:j2,jk) 
     344            END DO 
     345#endif 
     346      ELSE 
     347         tabres_child(:,:,:) = 0. 
     348# if defined key_vertical 
    328349! VERTICAL REFINEMENT BEGIN 
    329          tabres_child(:,:,:) = 0. 
    330           
    331350         DO jj=j1,j2 
    332351         DO ji=i1,i2 
     
    347366             h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 
    348367! Should be able to remove the next IF/ELSEIF statement once scale factors are dealt with properly 
    349              if (h_diff < 0.) then 
     368             if (h_diff < -1.e-4) then 
    350369             print *,'CHECK YOUR BATHY ...' 
    351370             stop 
     
    359378         ENDDO 
    360379         ENDDO 
     380#else 
     381            DO jk=1,jpk 
     382               DO jj=j1,j2 
     383                  DO ji=i1,i2 
     384                     tabres_child(:,:,:) = tabres(:,:,:,1)* r1_e2u(ji,jj) / e3u_n(ji,jj,jk) 
     385                  END DO 
     386               END DO 
     387            END DO 
     388#endif 
    361389          
    362390! WARNING : 
     
    408436      IF (before) THEN 
    409437         zrhox = Agrif_Rhox() 
     438#if defined key_vertical 
    410439         DO jk=k1,k2 
    411440            DO jj=j1,j2 
     
    416445            END DO 
    417446         END DO 
    418       ELSE 
     447#else 
     448            DO jk=k1,k2 
     449               DO jj=j1,j2 
     450                  DO ji=i1,i2 
     451                     tabres(ji,jj,jk,1) = zrhox * e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk) 
     452                  END DO 
     453               END DO 
     454            END DO 
     455#endif 
     456      ELSE 
     457         tabres_child(:,:,:) = 0. 
    419458! VERTICAL REFINEMENT BEGIN 
    420          tabres_child(:,:,:) = 0. 
    421           
     459#if defined key_vertical 
    422460         DO jj=j1,j2 
    423461         DO ji=i1,i2 
     
    438476             h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 
    439477! Should be able to remove the next IF/ELSEIF statement once scale factors are dealt with properly 
    440              if (h_diff < 0.) then 
     478             if (h_diff < -1.e-4) then 
    441479             print *,'CHECK YOUR BATHY ...' 
    442480             stop 
     
    450488         ENDDO 
    451489         ENDDO 
     490#else 
     491            DO jk=k1,k2 
     492               DO jj=j1,j2 
     493                  DO ji=i1,i2 
     494                     tabres(ji,jj,jk,1) = e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk) 
     495                  END DO 
     496               END DO 
     497            END DO 
     498#endif 
    452499          
    453500! WARNING : 
Note: See TracChangeset for help on using the changeset viewer.