Changeset 5294


Ignore:
Timestamp:
2015-05-26T16:29:03+02:00 (5 years ago)
Author:
timgraham
Message:

Fixes to hbatt calculation (corrected loop indices)
For ln_sf12 case all thickness variables now match those output in AMM12 meshmask.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5187_UKMO13_simplification/NEMOGCM/TOOLS/SCOORD_GEN/src/scoord_gen.F90

    r5269 r5294  
    126126         END DO 
    127127      END DO 
     128      WRITE(*,*) 'domzgr_sco print', bathy(196,147) 
    128129      !  
    129130      ! smooth the bathymetry (if required) 
     
    147148      zri(:,:) = 1. 
    148149      zrj(:,:) = 1. 
     150 
    149151      !                                                            ! ================ ! 
    150152      DO WHILE( jl <= 10000 .AND. ( zrmax - rn_rmax ) > 1.e-8 ) !  Iterative loop  ! 
     
    156158         ! we could exit DO WHILE prematurely before checking r-value 
    157159         ! of current zenv 
    158 !         DO jj = 1, nlcj 
    159 !            DO ji = 1, nlci 
    160          DO jj = 1, jpi !jpi or jpim1? 
    161             DO ji = 1, jpj 
     160         DO jj = 1, jpj  
     161            DO ji = 1, jpi 
    162162               zrmax = MAX( zrmax, ABS(zri(ji,jj)), ABS(zrj(ji,jj)) ) 
    163163            END DO 
     
    165165         zri(:,:) = 0. 
    166166         zrj(:,:) = 0. 
    167 !         DO jj = 1, nlci 
    168  !           DO ji = 1, nlcj 
    169  !              iip1 = MIN( ji+1, nlci )      ! force zri = 0 on last line (ji=ncli+1 to jpi) 
    170  !              ijp1 = MIN( jj+1, nlcj )      ! force zrj = 0 on last raw  (jj=nclj+1 to jpj) 
    171  !              IF( (zenv(ji,jj) > 0.) .AND. (zenv(iip1,jj) > 0.)) THEN 
    172  !                 zri(ji,jj) = ( zenv(iip1,jj  ) - zenv(ji,jj) ) / ( zenv(iip1,jj  ) + zenv(ji,jj) ) 
    173  !              END IF 
    174  !              IF( (zenv(ji,jj) > 0.) .AND. (zenv(ji,ijp1) > 0.)) THEN 
    175  !                 zrj(ji,jj) = ( zenv(ji  ,ijp1) - zenv(ji,jj) ) / ( zenv(ji  ,ijp1) + zenv(ji,jj) ) 
    176  !              END IF 
    177  !              IF( zri(ji,jj) >  rn_rmax )   ztmpi1(ji  ,jj  ) = zenv(iip1,jj  ) * zrfact 
    178  !              IF( zri(ji,jj) < -rn_rmax )   ztmpi2(iip1,jj  ) = zenv(ji  ,jj  ) * zrfact 
    179  !              IF( zrj(ji,jj) >  rn_rmax )   ztmpj1(ji  ,jj  ) = zenv(ji  ,ijp1) * zrfact 
    180  !              IF( zrj(ji,jj) < -rn_rmax )   ztmpj2(ji  ,ijp1) = zenv(ji  ,jj  ) * zrfact 
    181  !           END DO 
    182  !        END DO 
    183          DO jj = 1, jpi-1 
    184             DO ji = 1, jpj-1 
    185                iip1 = ji+1       
    186                ijp1 = jj+1       
     167         DO jj = 1, jpj 
     168            DO ji = 1, jpi 
     169               iip1 = MIN(ji+1,jpi)  
     170               ijp1 = MIN(jj+1,jpj)      
    187171               IF( (zenv(ji,jj) > 0.) .AND. (zenv(iip1,jj) > 0.)) THEN 
    188172                  zri(ji,jj) = ( zenv(iip1,jj  ) - zenv(ji,jj) ) / ( zenv(iip1,jj  ) + zenv(ji,jj) ) 
     
    200184         WRITE(*,*) 'zgr_sco :   iter= ',jl, ' rmax= ', zrmax 
    201185         ! 
    202          DO jj = 1, jpi 
    203             DO ji = 1, jpj 
     186         DO jj = 1, jpj 
     187            DO ji = 1, jpi 
    204188               zenv(ji,jj) = MAX(zenv(ji,jj), ztmpi1(ji,jj), ztmpi2(ji,jj), ztmpj1(ji,jj), ztmpj2(ji,jj) ) 
    205189            END DO 
     
    575559         where (e3vw_0  (:,:).eq.0.0)  e3vw_0(:,:) = 1.0 
    576560          
    577          WRITE(*,*) 'Writing level ',jk,' to file' 
    578561         CALL write_netcdf_vars(jk) 
    579          WRITE(*,*) 'Written level ',jk,' to file' 
     562 
     563         DO jj = 1, jpj 
     564            DO ji = 1, jpi 
     565                  IF( scobot(ji,jj) >= gdept_0(ji,jj) )   mbathy(ji,jj) = MAX( 2, jk ) 
     566                  IF( scobot(ji,jj) == 0.             )   mbathy(ji,jj) = 0 
     567            END DO 
     568         END DO 
     569 
    580570      ENDDO ! End of loop over jk 
    581571 
     
    707697      !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5) 
    708698      !!---------------------------------------------------------------------- 
    709       USE utils, ONLY : wp 
     699      USE utils, ONLY : wp, jpk, rn_theta 
     700      IMPLICIT NONE 
    710701      REAL(wp), INTENT(in) ::   pk1   ! continuous "k" coordinate 
    711702      REAL(wp), INTENT(in) ::   pbb   ! Stretching coefficient 
     
    741732      !! Reference  :   Siddorn and Furner, in prep 
    742733      !!---------------------------------------------------------------------- 
    743       USE utils, ONLY : jpk,jk,wp 
     734      USE utils, ONLY : jpk,wp,rn_alpha 
     735      IMPLICIT NONE 
    744736      REAL(wp), INTENT(in   ) ::   pk1           ! continuous "k" coordinate 
    745737      REAL(wp)                ::   p_gamma       ! stretched coordinate 
     
    764756      zb = (pzs - za1 - za*( zn1-0.5*(za1+zn1**2.0 ) ) ) / (zn1**3.0 - za1) 
    765757      zx = 1.0-za/2.0-zb 
    766   
     758 
    767759      p_gamma = za*(pk1*(1.0-pk1/2.0))+zb*pk1**3.0 +  & 
    768760                  & zx*( (rn_alpha+2.0)*pk1**(rn_alpha+1.0)- & 
Note: See TracChangeset for help on using the changeset viewer.