Changeset 5294 for branches

Timestamp:

2015-05-26T16:29:03+02:00 (9 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:

• branches/2015/dev_r5187_UKMO13_simplification/NEMOGCM/TOOLS/SCOORD_GEN/src/scoord_gen.F90 (modified) (9 diffs)

branches/2015/dev_r5187_UKMO13_simplification/NEMOGCM/TOOLS/SCOORD_GEN/src/scoord_gen.F90

@@ -126 +126 @@
          END DO
       END DO
+      WRITE(*,*) 'domzgr_sco print', bathy(196,147)
       ! 
       ! smooth the bathymetry (if required)
@@ -147 +148 @@
       zri(:,:) = 1.
       zrj(:,:) = 1.
+
       !                                                            ! ================ !
       DO WHILE( jl <= 10000 .AND. ( zrmax - rn_rmax ) > 1.e-8 ) !  Iterative loop  !
@@ -156 +158 @@
          ! we could exit DO WHILE prematurely before checking r-value
          ! of current zenv
-!         DO jj = 1, nlcj
-!            DO ji = 1, nlci
-         DO jj = 1, jpi !jpi or jpim1?
-            DO ji = 1, jpj
+         DO jj = 1, jpj 
+            DO ji = 1, jpi
                zrmax = MAX( zrmax, ABS(zri(ji,jj)), ABS(zrj(ji,jj)) )
             END DO
@@ -165 +165 @@
          zri(:,:) = 0.
          zrj(:,:) = 0.
-!         DO jj = 1, nlci
- !           DO ji = 1, nlcj
- !              iip1 = MIN( ji+1, nlci )      ! force zri = 0 on last line (ji=ncli+1 to jpi)
- !              ijp1 = MIN( jj+1, nlcj )      ! force zrj = 0 on last raw  (jj=nclj+1 to jpj)
- !              IF( (zenv(ji,jj) > 0.) .AND. (zenv(iip1,jj) > 0.)) THEN
- !                 zri(ji,jj) = ( zenv(iip1,jj  ) - zenv(ji,jj) ) / ( zenv(iip1,jj  ) + zenv(ji,jj) )
- !              END IF
- !              IF( (zenv(ji,jj) > 0.) .AND. (zenv(ji,ijp1) > 0.)) THEN
- !                 zrj(ji,jj) = ( zenv(ji  ,ijp1) - zenv(ji,jj) ) / ( zenv(ji  ,ijp1) + zenv(ji,jj) )
- !              END IF
- !              IF( zri(ji,jj) >  rn_rmax )   ztmpi1(ji  ,jj  ) = zenv(iip1,jj  ) * zrfact
- !              IF( zri(ji,jj) < -rn_rmax )   ztmpi2(iip1,jj  ) = zenv(ji  ,jj  ) * zrfact
- !              IF( zrj(ji,jj) >  rn_rmax )   ztmpj1(ji  ,jj  ) = zenv(ji  ,ijp1) * zrfact
- !              IF( zrj(ji,jj) < -rn_rmax )   ztmpj2(ji  ,ijp1) = zenv(ji  ,jj  ) * zrfact
- !           END DO
- !        END DO
-         DO jj = 1, jpi-1
-            DO ji = 1, jpj-1
-               iip1 = ji+1      
-               ijp1 = jj+1      
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+               iip1 = MIN(ji+1,jpi) 
+               ijp1 = MIN(jj+1,jpj)     
                IF( (zenv(ji,jj) > 0.) .AND. (zenv(iip1,jj) > 0.)) THEN
                   zri(ji,jj) = ( zenv(iip1,jj  ) - zenv(ji,jj) ) / ( zenv(iip1,jj  ) + zenv(ji,jj) )
@@ -200 +184 @@
          WRITE(*,*) 'zgr_sco :   iter= ',jl, ' rmax= ', zrmax
          !
-         DO jj = 1, jpi
-            DO ji = 1, jpj
+         DO jj = 1, jpj
+            DO ji = 1, jpi
                zenv(ji,jj) = MAX(zenv(ji,jj), ztmpi1(ji,jj), ztmpi2(ji,jj), ztmpj1(ji,jj), ztmpj2(ji,jj) )
             END DO
@@ -575 +559 @@
          where (e3vw_0  (:,:).eq.0.0)  e3vw_0(:,:) = 1.0
          
-         WRITE(*,*) 'Writing level ',jk,' to file'
          CALL write_netcdf_vars(jk)
-         WRITE(*,*) 'Written level ',jk,' to file'
+
+         DO jj = 1, jpj
+            DO ji = 1, jpi
+                  IF( scobot(ji,jj) >= gdept_0(ji,jj) )   mbathy(ji,jj) = MAX( 2, jk )
+                  IF( scobot(ji,jj) == 0.             )   mbathy(ji,jj) = 0
+            END DO
+         END DO
+
       ENDDO ! End of loop over jk
 
@@ -707 +697 @@
       !!                W-points at integer values - 1/2 (between 0.5 and jpk-0.5)
       !!----------------------------------------------------------------------
-      USE utils, ONLY : wp
+      USE utils, ONLY : wp, jpk, rn_theta
+      IMPLICIT NONE
       REAL(wp), INTENT(in) ::   pk1   ! continuous "k" coordinate
       REAL(wp), INTENT(in) ::   pbb   ! Stretching coefficient
@@ -741 +732 @@
       !! Reference  :   Siddorn and Furner, in prep
       !!----------------------------------------------------------------------
-      USE utils, ONLY : jpk,jk,wp
+      USE utils, ONLY : jpk,wp,rn_alpha
+      IMPLICIT NONE
       REAL(wp), INTENT(in   ) ::   pk1           ! continuous "k" coordinate
       REAL(wp)                ::   p_gamma       ! stretched coordinate
@@ -764 +756 @@
       zb = (pzs - za1 - za*( zn1-0.5*(za1+zn1**2.0 ) ) ) / (zn1**3.0 - za1)
       zx = 1.0-za/2.0-zb
- 
+
       p_gamma = za*(pk1*(1.0-pk1/2.0))+zb*pk1**3.0 +  &
                   & zx*( (rn_alpha+2.0)*pk1**(rn_alpha+1.0)- &