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

Changeset 6929


Ignore:
Timestamp:
2016-09-13T11:58:01+02:00 (8 years ago)
Author:
timgraham
Message:

Extended update changes to updateU and updateV

Location:
branches/2015/dev_r5803_UKMO_AGRIF_Vert_interp/NEMOGCM/NEMO/NST_SRC
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • branches/2015/dev_r5803_UKMO_AGRIF_Vert_interp/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90

    r6777 r6929  
    1 #define TWO_WAY        /* TWO WAY NESTING */ 
     1#undef TWO_WAY        /* TWO WAY NESTING */ 
    22#undef DECAL_FEEDBACK /* SEPARATION of INTERFACES*/ 
    33  
    … …  
    121121      !  
    122122      IF (MOD(nbcline,nbclineupdate) == 0) THEN 
     123         WRITE(numout,*) 'TG print 1' 
     124         CALL FLUSH(numout) 
    123125# if ! defined DECAL_FEEDBACK 
    124126         CALL Agrif_Update_Variable(tsn_id, procname=updateTS) 
    … …  
    126128         CALL Agrif_Update_Variable(tsn_id, locupdate=(/1,0/),procname=updateTS) 
    127129# endif 
    128       ELSE 
     130         WRITE(numout,*) 'TG print 2' 
     131         CALL FLUSH(numout) 
     132      ELSE 
     133         WRITE(numout,*) 'TG print 3' 
     134         CALL FLUSH(numout) 
    129135# if ! defined DECAL_FEEDBACK 
    130136         CALL Agrif_Update_Variable(tsn_id,locupdate=(/0,2/), procname=updateTS) 
    … …  
    132138         CALL Agrif_Update_Variable(tsn_id,locupdate=(/1,2/), procname=updateTS) 
    133139# endif 
     140         WRITE(numout,*) 'TG print 4' 
     141         CALL FLUSH(numout) 
    134142      ENDIF 
    135143      ! 
    … …  
    300308! VERTICAL REFINEMENT BEGIN 
    301309         ptab_child(:,:,:,:) = 0. 
    302           
     310 
    303311         DO jj=j1,j2 
    304312         DO ji=i1,i2 
    … …  
    314322             IF (tmask(ji,jj,jk) == 0) EXIT ! TODO: Will not work with ISF 
    315323             N_out = N_out + 1 
    316              h_out(N_out) = e3t_n(ji,jj,jk)!Parent grid scale factors. Could multiply by e1e2t here instead of division above 
     324             h_out(N_out) = e3t_n(ji,jj,jk) !Parent grid scale factors. Could multiply by e1e2t here instead of division above 
    317325           ENDDO 
    318326           IF (N_in > 0) THEN 
    319327             h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 
    320328! Should be able to remove the next IF/ELSEIF statement once scale factors are dealt with properly 
    321              IF abs(h_diff > 1.e-8) THEN 
     329!             IF abs(h_diff > 1.e-8) THEN 
    322330!               N_in = N_in + 1 
    323331!               h_in(N_in) = h_diff 
    324332!               tabin(N_in,:) = tabin(N_in-1,:) 
    325              ELSEIF (h_diff < 0) THEN 
     333             IF (h_diff < 0) THEN 
    326334             print *,'CHECK YOUR bathy T points ...',ji,jj,h_diff,sum(h_in(1:N_in)),sum(h_out(1:N_out)) 
    327335             print *,'Nval = ',N_out,mbathy(ji,jj) 
    … …  
    372380      ENDIF 
    373381      !  
     382      WRITE(numout,*) 'I got to end of updateTS before=',before 
     383      CALL FLUSH(numout) 
    374384   END SUBROUTINE updateTS 
    375385 
    376    SUBROUTINE updateu( ptab, i1, i2, j1, j2, k1, k2, before ) 
     386   SUBROUTINE updateu( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
    377387      !!--------------------------------------------- 
    378388      !!           *** ROUTINE updateu *** 
    379389      !!--------------------------------------------- 
    380390      !! 
    381       INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 
    382       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
     391      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2, n1, n2 
     392      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,2), INTENT(inout) :: ptab 
    383393      LOGICAL                               , INTENT(in   ) :: before 
    384394      ! 
    … …  
    386396      REAL(wp) ::   zrhoy 
    387397! VERTICAL REFINEMENT BEGIN 
    388       REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: ptab_child 
     398      REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk,2) :: ptab_child 
    389399      REAL(wp) :: h_in(k1:k2) 
    390400      REAL(wp) :: h_out(1:jpk) 
    … …  
    395405      !!--------------------------------------------- 
    396406      !  
     407      WRITE(numout,*) 'TG print 5: Start of updateu before = ',before 
     408      CALL FLUSH(numout) 
    397409      IF( before ) THEN 
    398410         zrhoy = Agrif_Rhoy() 
    … …  
    400412            DO jj=j1,j2 
    401413               DO ji=i1,i2 
    402                   ptab(ji,jj,jk) = e2u(ji,jj) * e3u_n(ji,jj,jk) * un(ji,jj,jk) 
    403                END DO 
    404             END DO 
    405          END DO 
    406          ptab = zrhoy * ptab 
     414                  ptab(ji,jj,jk,1) = zrhoy * e2u(ji,jj) * e3u_n(ji,jj,jk) * un(ji,jj,jk) 
     415                  ptab(ji,jj,jk,2) = umask(ji,jj,jk) * zrhoy * e2u(ji,jj) * e3u_n(ji,jj,jk)  
     416               END DO 
     417            END DO 
     418         END DO 
    407419      ELSE 
    408420! VERTICAL REFINEMENT BEGIN 
    409          ptab_child(:,:,:) = 0. 
     421         ptab_child(:,:,:,:) = 0. 
    410422          
    411423         DO jj=j1,j2 
    412424         DO ji=i1,i2 
    413425           N_in = 0 
    414            DO jk=k1,k2 
    415              IF (update_scales_u(ji,jj,jk) == 0) EXIT 
     426           DO jk=k1,k2 !k2=jpk of child grid 
     427             IF (ptab(ji,jj,jk,2) == 0) EXIT 
    416428             N_in = N_in + 1 
    417              tabin(jk) = ptab(ji,jj,jk)/update_scales_u(ji,jj,jk) 
    418              h_in(N_in) = update_scales_u(ji,jj,jk) 
     429             tabin(jk) = ptab(ji,jj,jk)/ptab(ji,jj,jk,2) 
     430             h_in(N_in) = ptab(ji,jj,jk,2)/e2u(ji,jj) 
    419431           ENDDO 
    420432           N_out = 0 
    … …  
    426438           IF (N_in * N_out > 0) THEN 
    427439             h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 
     440! Should be able to remove the next IF/ELSEIF statement once scale factors are dealt with properly 
    428441             if (h_diff < 0.) then 
    429442             print *,'CHECK YOUR BATHY ...' 
    430443             stop 
    431              else ! Extends with 0 
    432              N_in = N_in + 1 
    433              tabin(N_in) = 0. 
    434              h_in(N_in) = h_diff 
     444!             else ! Extends with 0 
     445!             N_in = N_in + 1 
     446!             tabin(N_in) = 0. 
     447!             h_in(N_in) = h_diff 
    435448             endif 
    436              CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),ptab_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out) 
     449             CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),ptab_child(ji,jj,1:N_out,1),h_out(1:N_out),N_in,N_out) 
    437450          ENDIF 
    438451         ENDDO 
    … …  
    448461            DO jj=j1,j2 
    449462               DO ji=i1,i2 
    450                   ptab_child(ji,jj,jk) = ptab_child(ji,jj,jk) / e2u(ji,jj) 
     463!Following line now replaced by division higher up I think 
     464!                  ptab_child(ji,jj,jk) = ptab_child(ji,jj,jk) / e2u(ji,jj) 
    451465                  ! 
    452466                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
    453467                     ub(ji,jj,jk) = ub(ji,jj,jk) &  
    454                            & + atfp * ( ptab_child(ji,jj,jk) - un(ji,jj,jk) ) * umask(ji,jj,jk) 
     468                           & + atfp * ( ptab_child(ji,jj,jk,1) - un(ji,jj,jk) ) * umask(ji,jj,jk) 
    455469                  ENDIF 
    456470                  ! 
    457                   un(ji,jj,jk) = ptab_child(ji,jj,jk) * umask(ji,jj,jk) 
     471                  un(ji,jj,jk) = ptab_child(ji,jj,jk,1) * umask(ji,jj,jk) 
    458472               END DO 
    459473            END DO 
    … …  
    461475      ENDIF 
    462476      !  
     477      WRITE(numout,*) 'TG print 6: End of updateu before = ',before 
     478      CALL FLUSH(numout) 
    463479   END SUBROUTINE updateu 
    464480 
    465    SUBROUTINE updatev( ptab, i1, i2, j1, j2, k1, k2, before ) 
     481   SUBROUTINE updatev( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
    466482      !!--------------------------------------------- 
    467483      !!           *** ROUTINE updatev *** 
    468484      !!--------------------------------------------- 
    469485      !! 
    470       INTEGER :: i1,i2,j1,j2,k1,k2 
     486      INTEGER :: i1,i2,j1,j2,k1,k2,n1,n2 
    471487      INTEGER :: ji,jj,jk 
    472       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ptab 
     488      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,2) :: ptab 
    473489      LOGICAL :: before 
    474490      !! 
    475491      REAL(wp) :: zrhox 
    476492! VERTICAL REFINEMENT BEGIN 
    477       REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: ptab_child 
     493      REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk,2) :: ptab_child 
    478494      REAL(wp) :: h_in(k1:k2) 
    479495      REAL(wp) :: h_out(1:jpk) 
    … …  
    484500      !!---------------------------------------------       
    485501      ! 
     502      WRITE(numout,*) 'TG print 7: Start of updatev before = ',before 
     503      CALL FLUSH(numout) 
    486504      IF (before) THEN 
    487505         zrhox = Agrif_Rhox() 
    … …  
    489507            DO jj=j1,j2 
    490508               DO ji=i1,i2 
    491                   ptab(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk) 
    492                   ptab(ji,jj,jk) = ptab(ji,jj,jk) * e3v_n(ji,jj,jk) 
    493                END DO 
    494             END DO 
    495          END DO 
    496          ptab = zrhox * ptab 
     509                  ptab(ji,jj,jk,1) = zrhox * e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk) 
     510                  ptab(ji,jj,jk,2) = vmask(ji,jj,jk) * zrhox * e1v(ji,jj) * e3v_n(ji,jj,jk)  
     511               END DO 
     512            END DO 
     513         END DO 
    497514      ELSE 
    498515! VERTICAL REFINEMENT BEGIN 
    … …  
    505522             IF (update_scales_v(ji,jj,jk) == 0) EXIT 
    506523             N_in = N_in + 1 
    507              tabin(jk) = ptab(ji,jj,jk)/update_scales_v(ji,jj,jk) 
    508              h_in(N_in) = update_scales_v(ji,jj,jk) 
     524             tabin(jk) = ptab(ji,jj,1)/ptab(ji,jj,jk,2) 
     525             h_in(N_in) = ptab(ji,jj,jk,2)/e1v(ji,jj) 
    509526           ENDDO 
    510527           N_out = 0 
    … …  
    516533           IF (N_in * N_out > 0) THEN 
    517534             h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 
     535! Should be able to remove the next IF/ELSEIF statement once scale factors are dealt with properly 
    518536             if (h_diff < 0.) then 
    519537             print *,'CHECK YOUR BATHY ...' 
    520538             stop 
    521              else ! Extends with 0 
    522              N_in = N_in + 1 
    523              tabin(N_in) = 0. 
    524              h_in(N_in) = h_diff 
     539!             else ! Extends with 0 
     540!             N_in = N_in + 1 
     541!             tabin(N_in) = 0. 
     542!             h_in(N_in) = h_diff 
    525543             endif 
    526              CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),ptab_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out) 
     544             CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),ptab_child(ji,jj,1:N_out,1),h_out(1:N_out),N_in,N_out) 
    527545          ENDIF 
    528546         ENDDO 
    … …  
    538556            DO jj=j1,j2 
    539557               DO ji=i1,i2 
    540                   ptab_child(ji,jj,jk) = ptab_child(ji,jj,jk) / e1v(ji,jj) 
     558!Following line now replaced by division higher up I think 
     559!                  ptab_child(ji,jj,jk) = ptab_child(ji,jj,jk) / e1v(ji,jj) 
    541560                  ! 
    542561                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
    543562                     vb(ji,jj,jk) = vb(ji,jj,jk) &  
    544                            & + atfp * ( ptab_child(ji,jj,jk) - vn(ji,jj,jk) ) * vmask(ji,jj,jk) 
     563                           & + atfp * ( ptab_child(ji,jj,jk,1) - vn(ji,jj,jk) ) * vmask(ji,jj,jk) 
    545564                  ENDIF 
    546565                  ! 
    547                   vn(ji,jj,jk) = ptab_child(ji,jj,jk) * vmask(ji,jj,jk) 
    548                END DO 
    549             END DO 
    550          END DO 
    551       ENDIF 
     566                  vn(ji,jj,jk) = ptab_child(ji,jj,jk,1) * vmask(ji,jj,jk) 
     567               END DO 
     568            END DO 
     569         END DO 
     570      ENDIF 
     571      WRITE(numout,*) 'TG print 8: End of updatev before = ',before 
    552572      !  
    553573   END SUBROUTINE updatev 

  • branches/2015/dev_r5803_UKMO_AGRIF_Vert_interp/NEMOGCM/NEMO/NST_SRC/agrif_user.F90

    r6454 r6929  
    380380   CALL agrif_declare_variable((/1,2,0,0/),(/2,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_interp_id) 
    381381   CALL agrif_declare_variable((/2,1,0,0/),(/3,2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_interp_id) 
    382    CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_update_id) 
    383    CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_update_id) 
     382   CALL agrif_declare_variable((/1,2,0,0/),(/2,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_update_id) 
     383   CALL agrif_declare_variable((/2,1,0,0/),(/3,2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_update_id) 
    384384   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_sponge_id) 
    385385   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_sponge_id) 
Note: See TracChangeset for help on using the changeset viewer.