/[MITgcm]/MITgcm/model/src/update_masks_etc.F
ViewVC logotype

Diff of /MITgcm/model/src/update_masks_etc.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.1 by heimbach, Wed Jun 7 01:45:43 2006 UTC revision 1.2 by jmc, Sun Jul 23 23:32:33 2006 UTC
# Line 9  C     !INTERFACE: Line 9  C     !INTERFACE:
9        SUBROUTINE UPDATE_MASKS_ETC( myThid )        SUBROUTINE UPDATE_MASKS_ETC( myThid )
10  C     !DESCRIPTION: \bv  C     !DESCRIPTION: \bv
11  C     *==========================================================*  C     *==========================================================*
12  C     | SUBROUTINE UPDATE_MASKS_ETC                                    C     | SUBROUTINE UPDATE_MASKS_ETC
13  C     | o Re-initialise masks and topography factors after a new  C     | o Re-initialise masks and topography factors after a new
14  C     |   hFacC has been calculated by the minimizer                  C     |   hFacC has been calculated by the minimizer
15  C     *==========================================================*  C     *==========================================================*
16  C     | These arrays are used throughout the code and describe      C     | These arrays are used throughout the code and describe    
17  C     | the topography of the domain through masks (0s and 1s)      C     | the topography of the domain through masks (0s and 1s)    
# Line 43  C     myThid -  Number of this instance Line 43  C     myThid -  Number of this instance
43    
44  #ifdef ALLOW_DEPTH_CONTROL  #ifdef ALLOW_DEPTH_CONTROL
45  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
 C     == Local variables in common ==  
 C     tmpfld  - Temporary array used to compute & write Total Depth  
 C               has to be in common for multi threading  
       COMMON / LOCAL_INI_MASKS_ETC / tmpfld  
       _RS tmpfld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)  
46  C     == Local variables ==  C     == Local variables ==
47  C     bi,bj  - Loop counters  C     bi,bj   :: Loop counters
48  C     I,J,K  C     I,J,K
49    C     tmpfld  :: Temporary array used to compute & write Total Depth
50        INTEGER bi, bj        INTEGER bi, bj
51        INTEGER  I, J, K        INTEGER I, J, K
52  #ifdef ALLOW_NONHYDROSTATIC        _RS tmpfld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
       INTEGER Km1  
       _RL hFacUpper,hFacLower  
 #endif  
 #ifdef ALLOW_NONHYDROSTATIC  
 CML   new auxilliary variable  
       _RL recip_hFacU_tmp  
       CHARACTER*(MAX_LEN_MBUF) msgBuf  
 #endif  
53        CHARACTER*(MAX_LEN_MBUF) suff        CHARACTER*(MAX_LEN_MBUF) suff
54  Cml(  Cml(
55        INTEGER Im1, Jm1        INTEGER Im1, Jm1
# Line 174  C    &         'Model Depths K Index' , Line 162  C    &         'Model Depths K Index' ,
162  CML I assume that R_low is not changed anywhere else in the code  CML I assume that R_low is not changed anywhere else in the code
163  CML and since it is not changed in this routine, we don't need to  CML and since it is not changed in this routine, we don't need to
164  CML print it again.  CML print it again.
165  CML      CALL PLOT_FIELD_XYRS(R_low,  CML      CALL PLOT_FIELD_XYRS(R_low,
166  CML     &         'Model R_low (ini_masks_etc)', 1, myThid)  CML     &         'Model R_low (ini_masks_etc)', 1, myThid)
167        CALL PLOT_FIELD_XYRS(Ro_surf,        CALL PLOT_FIELD_XYRS(Ro_surf,
168       &         'Model Ro_surf (update_masks_etc)', 1, myThid)       &         'Model Ro_surf (update_masks_etc)', 1, myThid)
169    
170  C     Calculate quantities derived from XY depth map  C     Calculate quantities derived from XY depth map
# Line 190  C         Inverse of fluid column thickn Line 178  C         Inverse of fluid column thickn
178            IF ( tmpfld(i,j,bi,bj) .LE. 0. ) THEN            IF ( tmpfld(i,j,bi,bj) .LE. 0. ) THEN
179             recip_Rcol(i,j,bi,bj) = 0.             recip_Rcol(i,j,bi,bj) = 0.
180            ELSE            ELSE
181             recip_Rcol(i,j,bi,bj) = 1. / tmpfld(i,j,bi,bj)             recip_Rcol(i,j,bi,bj) = 1. _d 0 / tmpfld(i,j,bi,bj)
182            ENDIF            ENDIF
183           ENDDO           ENDDO
184          ENDDO          ENDDO
# Line 238  Cml              hFacS(I,J,K,bi,bj)= Line 226  Cml              hFacS(I,J,K,bi,bj)=
226                hFacS(I,J,K,bi,bj)=maskS(I,J,K,bi,bj)*                hFacS(I,J,K,bi,bj)=maskS(I,J,K,bi,bj)*
227  #ifdef USE_SMOOTH_MIN  #ifdef USE_SMOOTH_MIN
228       &           smoothMin_R4(hFacC(I,J,K,bi,bj),hFacC(I,Jm1,K,bi,bj))       &           smoothMin_R4(hFacC(I,J,K,bi,bj),hFacC(I,Jm1,K,bi,bj))
229  #else              #else
230       &                    MIN(hFacC(I,J,K,bi,bj),hFacC(I,Jm1,K,bi,bj))       &                    MIN(hFacC(I,J,K,bi,bj),hFacC(I,Jm1,K,bi,bj))
231  #endif /* USE_SMOOTH_MIN */  #endif /* USE_SMOOTH_MIN */
232             ENDIF                     ENDIF
233            ENDDO            ENDDO
234           ENDDO           ENDDO
235          ENDDO          ENDDO
# Line 303  Cml   optimization! Line 291  Cml   optimization!
291            DO I=1-Olx,sNx+Olx            DO I=1-Olx,sNx+Olx
292             IF (hFacC(I,J,K,bi,bj) .NE. 0. ) THEN             IF (hFacC(I,J,K,bi,bj) .NE. 0. ) THEN
293  Cml           IF (maskC(I,J,K,bi,bj) .NE. 0. ) THEN  Cml           IF (maskC(I,J,K,bi,bj) .NE. 0. ) THEN
294              recip_hFacC(I,J,K,bi,bj) = 1. / hFacC(I,J,K,bi,bj)              recip_hFacC(I,J,K,bi,bj) = 1. _d 0 / hFacC(I,J,K,bi,bj)
295  Cml            maskC(I,J,K,bi,bj) = 1.  Cml            maskC(I,J,K,bi,bj) = 1.
296             ELSE             ELSE
297              recip_hFacC(I,J,K,bi,bj) = 0.              recip_hFacC(I,J,K,bi,bj) = 0.
# Line 311  Cml            maskC(I,J,K,bi,bj) = 0. Line 299  Cml            maskC(I,J,K,bi,bj) = 0.
299             ENDIF             ENDIF
300             IF (hFacW(I,J,K,bi,bj) .NE. 0. ) THEN             IF (hFacW(I,J,K,bi,bj) .NE. 0. ) THEN
301  Cml           IF (maskW(I,J,K,bi,bj) .NE. 0. ) THEN  Cml           IF (maskW(I,J,K,bi,bj) .NE. 0. ) THEN
302              recip_hFacW(I,J,K,bi,bj) = 1. / Hfacw(I,J,K,bi,bj)              recip_hFacW(I,J,K,bi,bj) = 1. _d 0 / hFacw(I,J,K,bi,bj)
303  Cml            maskW(I,J,K,bi,bj) = 1.  Cml            maskW(I,J,K,bi,bj) = 1.
304             ELSE             ELSE
305              recip_hFacW(I,J,K,bi,bj) = 0.              recip_hFacW(I,J,K,bi,bj) = 0.
# Line 319  Cml            maskW(I,J,K,bi,bj) = 0. Line 307  Cml            maskW(I,J,K,bi,bj) = 0.
307             ENDIF             ENDIF
308             IF (hFacS(I,J,K,bi,bj) .NE. 0. ) THEN             IF (hFacS(I,J,K,bi,bj) .NE. 0. ) THEN
309  Cml           IF (maskS(I,J,K,bi,bj) .NE. 0. ) THEN  Cml           IF (maskS(I,J,K,bi,bj) .NE. 0. ) THEN
310              recip_hFacS(I,J,K,bi,bj) = 1. / hFacS(I,J,K,bi,bj)              recip_hFacS(I,J,K,bi,bj) = 1. _d 0 / hFacS(I,J,K,bi,bj)
311  Cml            maskS(I,J,K,bi,bj) = 1.  Cml            maskS(I,J,K,bi,bj) = 1.
312             ELSE             ELSE
313              recip_hFacS(I,J,K,bi,bj) = 0.              recip_hFacS(I,J,K,bi,bj) = 0.
# Line 361  Cml           IF (hFacS(I,J,K,bi,bj).NE. Line 349  Cml           IF (hFacS(I,J,K,bi,bj).NE.
349  C - end bi,bj loops.  C - end bi,bj loops.
350         ENDDO         ENDDO
351        ENDDO        ENDDO
 C     _EXCH_XYZ_R4(recip_hFacC    , myThid )  
 C     _EXCH_XYZ_R4(recip_hFacW    , myThid )  
 C     _EXCH_XYZ_R4(recip_hFacS    , myThid )  
 C     _EXCH_XYZ_R4(maskW    , myThid )  
 C     _EXCH_XYZ_R4(maskS    , myThid )  
352    
353  #ifdef ALLOW_NONHYDROSTATIC  c #ifdef ALLOW_NONHYDROSTATIC
354  C--   Calculate the reciprocal hfac distance/volume for W cells  C--   Calculate "recip_hFacU" = reciprocal hfac distance/volume for W cells
355        DO bj = myByLo(myThid), myByHi(myThid)  C     not used ; computed locally in CALC_GW
356         DO bi = myBxLo(myThid), myBxHi(myThid)  c #endif
357          DO K=1,Nr  
          Km1=max(K-1,1)  
 CML   Changed if-statement  
          IF (Km1.EQ.K) THEN  
             hFacUpper=0.  
          ELSE  
             hFacUpper=drF(Km1)/(drF(Km1)+drF(K))  
          ENDIF  
          hFacLower=drF(K)/(drF(Km1)+drF(K))  
          DO J=1-Oly,sNy+Oly  
           DO I=1-Olx,sNx+Olx  
            recip_hFacU_tmp = 0.  
            IF (hFacC(I,J,K,bi,bj).EQ.0.) THEN  
               recip_hFacU_tmp=0.  
            ELSEIF(hFacC(I,J,K,bi,bj).GT.0.  
      &             .AND. hFacC(I,J,K,bi,bj).LE.0.5) THEN  
             recip_hFacU_tmp=  
      &         hFacUpper+hFacLower*hFacC(I,J,K,bi,bj)  
            ELSEIF (hFacC(I,J,K,bi,bj).GT.0.5) THEN  
             recip_hFacU_tmp=1.  
            ELSE  
             WRITE(msgBuf,'(A,3I4)') 'negative hFacC at ',I,J,K  
             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,  
      &           SQUEEZE_RIGHT , 1)  
            ENDIF  
            IF (recip_hFacU_tmp.NE.0.) THEN  
             recip_hFacU(I,J,K,bi,bj)=1./recip_hFacU_tmp  
            ELSE  
             recip_hFacU(I,J,K,bi,bj)=0.  
            ENDIF  
           ENDDO  
          ENDDO  
         ENDDO  
        ENDDO  
       ENDDO  
 C     _EXCH_XY_R4(recip_hFacU, myThid )  
 #endif  
 C  
358  #endif /* ALLOW_DEPTH_CONTROL */  #endif /* ALLOW_DEPTH_CONTROL */
359        RETURN        RETURN
360        END        END
# Line 447  Cml      smoothMin_R8 = MIN(a,b) Line 393  Cml      smoothMin_R8 = MIN(a,b)
393        end        end
394    
395        _RS function smoothAbs_R4( x )        _RS function smoothAbs_R4( x )
396          
397        implicit none        implicit none
398  C     === Global variables ===  C     === Global variables ===
399  #include "SIZE.h"  #include "SIZE.h"
# Line 484  c Line 430  c
430        end        end
431    
432        _RL function smoothAbs_R8( x )        _RL function smoothAbs_R8( x )
433          
434        implicit none        implicit none
435  C     === Global variables ===  C     === Global variables ===
436  #include "SIZE.h"  #include "SIZE.h"
# Line 507  c     limit of smoothMin(a,b) = min(a,b) Line 453  c     limit of smoothMin(a,b) = min(a,b)
453              sf  = 0.D0              sf  = 0.D0
454              rsf = 0.D0              rsf = 0.D0
455           end if           end if
456  c      c
457           if ( x .ge. smoothAbsFuncRange ) then           if ( x .ge. smoothAbsFuncRange ) then
458              smoothAbs_R8 = x              smoothAbs_R8 = x
459           else if ( x .le. -smoothAbsFuncRange ) then           else if ( x .le. -smoothAbsFuncRange ) then
# Line 532  Cml#endif /* ALLOW_DEPTH_CONTROL */ Line 478  Cml#endif /* ALLOW_DEPTH_CONTROL */
478  Cml      subroutine limit_hfacc_to_one( hf )  Cml      subroutine limit_hfacc_to_one( hf )
479  Cml  Cml
480  Cml      _RL hf  Cml      _RL hf
481  Cml        Cml
482  Cml      if ( hf .gt. 1. _d 0 ) then  Cml      if ( hf .gt. 1. _d 0 ) then
483  Cml       hf = 1. _d 0  Cml       hf = 1. _d 0
484  Cml      endif  Cml      endif
# Line 543  Cml Line 489  Cml
489  Cml      subroutine adlimit_hfacc_to_one( hf, adhf )  Cml      subroutine adlimit_hfacc_to_one( hf, adhf )
490  Cml  Cml
491  Cml      _RL hf, adhf  Cml      _RL hf, adhf
492  Cml        Cml
493  Cml      return  Cml      return
494  Cml      end  Cml      end
495    
# Line 558  cadj SUBROUTINE dummy_in_hfac ADNAME  = Line 504  cadj SUBROUTINE dummy_in_hfac ADNAME  =
504  cadj SUBROUTINE dummy_in_hfac FTLNAME = g_dummy_in_hfac  cadj SUBROUTINE dummy_in_hfac FTLNAME = g_dummy_in_hfac
505  #endif /* ALLOW_DEPTH_CONTROL */  #endif /* ALLOW_DEPTH_CONTROL */
506    
   
   
   
   
   
   
   
   
   
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22