Ignore:
Timestamp:
2014-02-06T17:47:57+01:00 (7 years ago)
Author:
jchanut
Message:

Missing Asselin correction with Agrif, #1203

Location:
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/NST_SRC
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90

    r4486 r4491  
    3232   LOGICAL , PUBLIC :: spongedoneT = .FALSE.   !: tracer   sponge layer indicator 
    3333   LOGICAL , PUBLIC :: spongedoneU = .FALSE.   !: dynamics sponge layer indicator 
     34   LOGICAL , PUBLIC :: lk_agrif_fstep = .TRUE. !: if true: first step 
    3435 
    3536   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) ::   spe1ur , spe2vr , spbtr2   !: ??? 
  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90

    r4486 r4491  
    145145         END DO 
    146146      ELSE 
     147         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 
     148         ! Add asselin part 
     149            DO jn = n1,n2 
     150               DO jk=k1,k2 
     151                  DO jj=j1,j2 
     152                     DO ji=i1,i2 
     153                        IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN 
     154                           tsb(ji,jj,jk,jn) = tsb(ji,jj,jk,jn) &  
     155                              & + atfp * ( tabres(ji,jj,jk,jn) & 
     156                              &             - tsn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 
     157                        ENDIF 
     158                     ENDDO 
     159                  ENDDO 
     160               ENDDO 
     161            ENDDO 
     162         ENDIF 
     163 
    147164         DO jn = n1,n2 
    148165            DO jk=k1,k2 
     
    150167                  DO ji=i1,i2 
    151168                     IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN  
    152                          tsn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) * tmask(ji,jj,jk) 
     169                        tsn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) * tmask(ji,jj,jk) 
    153170                     END IF 
    154171                  END DO 
     
    179196               DO ji=i1,i2 
    180197                  tabres(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk) 
    181                   tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3u(ji,jj,jk) 
     198                  tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3u_n(ji,jj,jk) 
    182199               END DO 
    183200            END DO 
     
    188205            DO jj=j1,j2 
    189206               DO ji=i1,i2 
    190                   un(ji,jj,jk) = tabres(ji,jj,jk) / (e2u(ji,jj)) 
    191                   un(ji,jj,jk) = un(ji,jj,jk) * umask(ji,jj,jk) 
    192                   un(ji,jj,jk) = un(ji,jj,jk) / fse3u(ji,jj,jk) 
     207                  tabres(ji,jj,jk) = tabres(ji,jj,jk) / e2u(ji,jj) / fse3u_n(ji,jj,jk) 
     208                  ! 
     209                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
     210                     ub(ji,jj,jk) = ub(ji,jj,jk) &  
     211                       & + atfp * ( tabres(ji,jj,jk) - un(ji,jj,jk) ) * umask(ji,jj,jk) 
     212                  ENDIF 
     213                  ! 
     214                  un(ji,jj,jk) = tabres(ji,jj,jk) * umask(ji,jj,jk) 
    193215               END DO 
    194216            END DO 
     
    217239               DO ji=i1,i2 
    218240                  tabres(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk) 
    219                   tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3v(ji,jj,jk) 
     241                  tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3v_n(ji,jj,jk) 
    220242               END DO 
    221243            END DO 
     
    226248            DO jj=j1,j2 
    227249               DO ji=i1,i2 
    228                   vn(ji,jj,jk) = tabres(ji,jj,jk) / (e1v(ji,jj)) 
    229                   vn(ji,jj,jk) = vn(ji,jj,jk) * vmask(ji,jj,jk) 
    230                   vn(ji,jj,jk) = vn(ji,jj,jk) / fse3v(ji,jj,jk) 
     250                  tabres(ji,jj,jk) = tabres(ji,jj,jk) / e1v(ji,jj) / fse3v_n(ji,jj,jk) 
     251                  ! 
     252                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
     253                     vb(ji,jj,jk) = vb(ji,jj,jk) &  
     254                       & + atfp * ( tabres(ji,jj,jk) - vn(ji,jj,jk) ) * vmask(ji,jj,jk) 
     255                  ENDIF 
     256                  ! 
     257                  vn(ji,jj,jk) = tabres(ji,jj,jk) * vmask(ji,jj,jk) 
    231258               END DO 
    232259            END DO 
     
    248275      INTEGER :: ji, jj, jk 
    249276      REAL(wp) :: zrhoy 
    250       REAL(wp) :: zhinv 
     277      REAL(wp) :: zcorr 
    251278 
    252279      IF (before) THEN 
     
    261288         DO jj=j1,j2 
    262289            DO ji=i1,i2 
    263                IF(umask(ji,jj,1) .NE. 0.) THEN              
    264                   spgu(ji,jj) = 0.e0 
    265                   DO jk=1,jpk 
    266                      spgu(ji,jj) = spgu(ji,jj) + fse3u(ji,jj,jk) * un(ji,jj,jk) 
    267                   END DO 
    268                   spgu(ji,jj) = spgu(ji,jj) * e2u(ji,jj) 
    269                   zhinv = (tabres(ji,jj)-spgu(ji,jj))/(hu(ji,jj)*e2u(ji,jj)) 
    270                   Do jk=1,jpk               
    271                      un(ji,jj,jk) = un(ji,jj,jk) + zhinv 
    272                      un(ji,jj,jk) = un(ji,jj,jk) * umask(ji,jj,jk)             
    273                   END DO 
    274                ENDIF 
     290               tabres(ji,jj) =  tabres(ji,jj) * hur(ji,jj) / e2u(ji,jj)   
     291               !     
     292               ! Update "now" 3d velocities: 
     293               spgu(ji,jj) = 0.e0 
     294               DO jk=1,jpkm1 
     295                  spgu(ji,jj) = spgu(ji,jj) + fse3u_n(ji,jj,jk) * un(ji,jj,jk) 
     296               END DO 
     297               spgu(ji,jj) = spgu(ji,jj) * hur(ji,jj) 
     298               ! 
     299               zcorr = tabres(ji,jj) - spgu(ji,jj) 
     300               DO jk=1,jpkm1               
     301                  un(ji,jj,jk) = un(ji,jj,jk) + zcorr * umask(ji,jj,jk)            
     302               END DO 
     303               ! 
    275304               ! Update barotropic velocities: 
    276                un_b(ji,jj) = tabres(ji,jj) * hur(ji,jj) / e2u(ji,jj) 
     305#if defined key_dynspg_ts 
     306               IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
     307                  zcorr = tabres(ji,jj) - un_b(ji,jj) 
     308                  ub_b(ji,jj) = ub_b(ji,jj) + atfp * zcorr * umask(ji,jj,1) 
     309               END IF 
     310#endif                
     311               un_b(ji,jj) = tabres(ji,jj) * umask(ji,jj,1) 
     312               !        
     313               ! Correct "before" velocities to hold correct bt component: 
     314               spgu(ji,jj) = 0.e0 
     315               DO jk=1,jpkm1 
     316                  spgu(ji,jj) = spgu(ji,jj) + fse3u_b(ji,jj,jk) * ub(ji,jj,jk) 
     317               END DO 
     318               spgu(ji,jj) = spgu(ji,jj) * hur_b(ji,jj) 
     319               ! 
     320               zcorr = ub_b(ji,jj) - spgu(ji,jj) 
     321               DO jk=1,jpkm1               
     322                  ub(ji,jj,jk) = ub(ji,jj,jk) + zcorr * umask(ji,jj,jk)            
     323               END DO 
     324               ! 
    277325            END DO 
    278326         END DO 
     
    292340      INTEGER :: ji, jj, jk 
    293341      REAL(wp) :: zrhox 
    294       REAL(wp) :: zhinv 
     342      REAL(wp) :: zcorr 
    295343 
    296344      IF (before) THEN 
     
    305353         DO jj=j1,j2 
    306354            DO ji=i1,i2 
    307                IF(vmask(ji,jj,1) .NE. 0.) THEN              
    308                   spgv(ji,jj) = 0. 
    309                   DO jk=1,jpk 
    310                      spgv(ji,jj) = spgv(ji,jj) + fse3v(ji,jj,jk) * vn(ji,jj,jk) 
    311                   END DO 
    312                   spgv(ji,jj) = spgv(ji,jj) * e1v(ji,jj) 
    313                   zhinv = (tabres(ji,jj)-spgv(ji,jj))/(hv(ji,jj)*e1v(ji,jj)) 
    314                   DO jk=1,jpk              
    315                      vn(ji,jj,jk) = vn(ji,jj,jk) + zhinv 
    316                      vn(ji,jj,jk) = vn(ji,jj,jk) * vmask(ji,jj,jk) 
    317                   END DO 
    318                ENDIF 
     355               tabres(ji,jj) =  tabres(ji,jj) * hvr(ji,jj) / e1v(ji,jj)   
     356               !     
     357               ! Update "now" 3d velocities: 
     358               spgv(ji,jj) = 0.e0 
     359               DO jk=1,jpkm1 
     360                  spgv(ji,jj) = spgv(ji,jj) + fse3v_n(ji,jj,jk) * vn(ji,jj,jk) 
     361               END DO 
     362               spgv(ji,jj) = spgv(ji,jj) * hvr(ji,jj) 
     363               ! 
     364               zcorr = tabres(ji,jj) - spgv(ji,jj) 
     365               DO jk=1,jpkm1               
     366                  vn(ji,jj,jk) = vn(ji,jj,jk) + zcorr * vmask(ji,jj,jk)            
     367               END DO 
     368               ! 
    319369               ! Update barotropic velocities: 
    320                vn_b(ji,jj) = tabres(ji,jj) * hvr(ji,jj) / e1v(ji,jj) 
     370#if defined key_dynspg_ts 
     371               IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
     372                  zcorr = tabres(ji,jj) - vn_b(ji,jj) 
     373                  vb_b(ji,jj) = vb_b(ji,jj) + atfp * zcorr * vmask(ji,jj,1) 
     374               END IF 
     375#endif                
     376               vn_b(ji,jj) = tabres(ji,jj) * vmask(ji,jj,1) 
     377               !        
     378               ! Correct "before" velocities to hold correct bt component: 
     379               spgv(ji,jj) = 0.e0 
     380               DO jk=1,jpkm1 
     381                  spgv(ji,jj) = spgv(ji,jj) + fse3v_b(ji,jj,jk) * vb(ji,jj,jk) 
     382               END DO 
     383               spgv(ji,jj) = spgv(ji,jj) * hvr_b(ji,jj) 
     384               ! 
     385               zcorr = vb_b(ji,jj) - spgv(ji,jj) 
     386               DO jk=1,jpkm1               
     387                  vb(ji,jj,jk) = vb(ji,jj,jk) + zcorr * vmask(ji,jj,jk)            
     388               END DO 
     389               ! 
    321390            END DO 
    322391         END DO 
     
    344413         END DO 
    345414      ELSE 
     415 
     416#if ! defined key_dynspg_ts 
     417         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 
     418            DO jj=j1,j2 
     419               DO ji=i1,i2 
     420                sshb(ji,jj) =   sshb(ji,jj) & 
     421                 & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1) 
     422               END DO 
     423            END DO 
     424         ENDIF 
     425#endif 
    346426         DO jj=j1,j2 
    347427            DO ji=i1,i2 
  • branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/NST_SRC/agrif_top_update.F90

    r3680 r4491  
    7878            ENDDO 
    7979         ELSE 
     80            IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 
     81            ! Add asselin part 
     82               DO jn = n1, n2 
     83                  DO jk = k1, k2 
     84                     DO jj = j1, j2 
     85                        DO ji = i1, i2 
     86                           IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN 
     87                              trb(ji,jj,jk,jn) = trb(ji,jj,jk,jn) &  
     88                                 & + atfp * ( tabres(ji,jj,jk,jn) & 
     89                                               - trn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 
     90                           ENDIF 
     91                        ENDDO 
     92                     ENDDO 
     93                  ENDDO 
     94               ENDDO 
     95            ENDIF 
     96 
    8097            DO jn = n1, n2 
    8198               DO jk = k1, k2 
Note: See TracChangeset for help on using the changeset viewer.