/[MITgcm]/MITgcm/pkg/gmredi/gmredi_slope_psi.F
ViewVC logotype

Diff of /MITgcm/pkg/gmredi/gmredi_slope_psi.F

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

revision 1.9 by jmc, Thu Dec 8 21:40:16 2005 UTC revision 1.12 by jmc, Tue Dec 8 21:42:22 2009 UTC
# Line 62  C     == Local variables == Line 62  C     == Local variables ==
62        _RL fpi        _RL fpi
63        PARAMETER(fpi=3.141592653589793047592d0)        PARAMETER(fpi=3.141592653589793047592d0)
64        INTEGER i,j        INTEGER i,j
65    #ifdef GMREDI_WITH_STABLE_ADJOINT
66          _RL slopeTmpSpec,slopeMaxSpec
67    #endif
68    
69    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
70    
71        slopeCutoff = SQRT( GM_slopeSqCutoff )        slopeCutoff = SQRT( GM_slopeSqCutoff )
72    
# Line 79  C     == Local variables == Line 84  C     == Local variables ==
84        kkey = (igmkey-1)*Nr + k        kkey = (igmkey-1)*Nr + k
85  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
86    
87    #ifndef GMREDI_WITH_STABLE_ADJOINT
88    c common case:
89    
90        IF (GM_taper_scheme.EQ.'orig' .OR.        IF (GM_taper_scheme.EQ.'orig' .OR.
91       &    GM_taper_scheme.EQ.'clipping') THEN       &    GM_taper_scheme.EQ.'clipping') THEN
92    
# Line 165  CADJ STORE dSigmaDrS(:,:)    = comlev1_b Line 173  CADJ STORE dSigmaDrS(:,:)    = comlev1_b
173    
174  #endif /* GM_EXCLUDE_CLIPPING */  #endif /* GM_EXCLUDE_CLIPPING */
175    
176          ELSEIF (GM_taper_scheme.EQ.'fm07') THEN
177    
178            STOP 'GMREDI_SLOPE_PSI: AdvForm not yet implemented for fm07'
179    
180        ELSE        ELSE
181    
182  #ifdef GM_EXCLUDE_TAPERING  #ifdef GM_EXCLUDE_TAPERING
# Line 178  CADJ STORE slopeX(:,:)       = comlev1_b Line 190  CADJ STORE slopeX(:,:)       = comlev1_b
190  CADJ STORE dSigmaDrW(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte  CADJ STORE dSigmaDrW(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
191  #endif  #endif
192    
193  C- Compute the slope, no clipping, but avoid reverse slope in negatively  C- Compute the slope, no clipping, but avoid reverse slope in negatively
194  C                                  stratified (Sigma_Z > 0) region :  C                                  stratified (Sigma_Z > 0) region :
195          DO j=1-Oly,sNy+Oly          DO j=1-Oly,sNy+Oly
196           DO i=1-Olx+1,sNx+Olx           DO i=1-Olx+1,sNx+Olx
# Line 261  C-      Simplest adiabatic tapering = Sm Line 273  C-      Simplest adiabatic tapering = Sm
273           DO i=1-Olx,sNx+Olx           DO i=1-Olx,sNx+Olx
274            Smod = ABS(SlopeY(i,j))            Smod = ABS(SlopeY(i,j))
275            IF ( Smod .GT. GM_maxSlope .AND.            IF ( Smod .GT. GM_maxSlope .AND.
276       &           Smod .LT. slopeCutoff )       &           Smod .LT. slopeCutoff )
277       &           taperY(i,j)=GM_maxSlope/(Smod+GM_Small_Number)       &           taperY(i,j)=GM_maxSlope/(Smod+GM_Small_Number)
278           ENDDO           ENDDO
279          ENDDO          ENDDO
# Line 273  C-      Gerdes, Koberle and Willebrand, Line 285  C-      Gerdes, Koberle and Willebrand,
285          DO j=1-Oly,sNy+Oly          DO j=1-Oly,sNy+Oly
286           DO i=1-Olx+1,sNx+Olx           DO i=1-Olx+1,sNx+Olx
287            IF ( ABS(SlopeX(i,j)) .GT. GM_maxSlope .AND.            IF ( ABS(SlopeX(i,j)) .GT. GM_maxSlope .AND.
288       &           ABS(SlopeX(i,j)) .LT. slopeCutoff )       &           ABS(SlopeX(i,j)) .LT. slopeCutoff )
289       &           taperX(i,j)=maxSlopeSqr/       &           taperX(i,j)=maxSlopeSqr/
290       &           ( SlopeX(i,j)*SlopeX(i,j) + GM_Small_Number )       &           ( SlopeX(i,j)*SlopeX(i,j) + GM_Small_Number )
291           ENDDO           ENDDO
# Line 355  C-      Large, Danabasoglu and Doney, JP Line 367  C-      Large, Danabasoglu and Doney, JP
367    
368        ENDIF        ENDIF
369    
370    
371    #else  /* GMREDI_WITH_STABLE_ADJOINT */
372    c special choice for adjoint/optimization of parameters
373    c (~ strong clipping, reducing non linearity of psi=f(K))
374    
375    
376    #ifdef ALLOW_AUTODIFF_TAMC
377    CADJ STORE slopeX(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
378    CADJ STORE dSigmaDrW(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
379    #endif
380            DO j=1-Oly,sNy+Oly
381             DO i=1-Olx+1,sNx+Olx
382              IF (dSigmaDrW(i,j).GE.-GM_Small_Number)
383         &        dSigmaDrW(i,j) = -GM_Small_Number
384             ENDDO
385            ENDDO
386    #ifdef ALLOW_AUTODIFF_TAMC
387    CADJ STORE dsigmadrW(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
388    #endif
389            DO j=1-Oly,sNy+Oly
390             DO i=1-Olx+1,sNx+Olx
391              SlopeX(i,j) = -SlopeX(i,j)/dSigmaDrW(i,j)
392              taperX(i,j) = 1. _d 0
393             ENDDO
394            ENDDO
395    
396    #ifdef ALLOW_AUTODIFF_TAMC
397    CADJ STORE slopeY(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
398    CADJ STORE dSigmaDrS(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
399    #endif
400    
401            DO j=1-Oly+1,sNy+Oly
402             DO i=1-Olx,sNx+Olx
403              IF (dSigmaDrS(i,j).GE.-GM_Small_Number)
404         &        dSigmaDrS(i,j) = -GM_Small_Number
405             ENDDO
406            ENDDO
407    #ifdef ALLOW_AUTODIFF_TAMC
408    CADJ STORE dsigmadrS(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
409    #endif
410            DO j=1-Oly+1,sNy+Oly
411             DO i=1-Olx,sNx+Olx
412              SlopeY(i,j) = -SlopeY(i,j)/dSigmaDrS(i,j)
413              taperY(i,j) = 1. _d 0
414             ENDDO
415            ENDDO
416    
417            slopeMaxSpec=1. _d -4
418    
419    CADJ STORE slopeX(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
420    CADJ STORE slopeY(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
421    
422            DO j=1-Oly,sNy+Oly
423             DO i=1-Olx+1,sNx+Olx
424           slopeTmpSpec=ABS(SlopeX(i,j))
425           IF ( slopeTmpSpec .GT. slopeMaxSpec ) then
426            SlopeX(i,j)=5.*SlopeX(i,j)*slopeMaxSpec/slopeTmpSpec
427           ELSE
428            SlopeX(i,j)=5.*SlopeX(i,j)
429           ENDIF
430           taperX(i,j)=1.
431             ENDDO
432            ENDDO
433            DO j=1-Oly+1,sNy+Oly
434             DO i=1-Olx,sNx+Olx
435           slopeTmpSpec=ABS(SlopeY(i,j))
436           IF ( slopeTmpSpec .GT. slopeMaxSpec ) then
437            SlopeY(i,j)=5.*SlopeY(i,j)*slopeMaxSpec/slopeTmpSpec
438           ELSE
439            SlopeY(i,j)=5.*SlopeY(i,j)
440           ENDIF
441           taperY(i,j)=1.
442             ENDDO
443            ENDDO
444    
445    #endif /* GMREDI_WITH_STABLE_ADJOINT */
446    
447  #endif /* BOLUS_ADVEC */  #endif /* BOLUS_ADVEC */
448  #endif /* ALLOW_GMREDI */  #endif /* ALLOW_GMREDI */
449    
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22