/[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.7 by jmc, Sun Nov 21 15:57:17 2004 UTC revision 1.11 by gforget, Fri May 30 21:10:25 2008 UTC
# Line 17  C     |================================= Line 17  C     |=================================
17  C     | On entry:                                                |  C     | On entry:                                                |
18  C     |            dSigmaDrW,S  contains the d/dz Sigma          |  C     |            dSigmaDrW,S  contains the d/dz Sigma          |
19  C     |            SlopeX/Y     contains X/Y gradients of sigma  |  C     |            SlopeX/Y     contains X/Y gradients of sigma  |
20  C     |            depthZ       contains the height (m) of level |  C     |            depthZ       contains the depth (< 0 !) [m]   |
21  C     | On exit:                                                 |  C     | On exit:                                                 |
22  C     |            dSigmaDrW,S  contains the effective dSig/dz   |  C     |            dSigmaDrW,S  contains the effective dSig/dz   |
23  C     |            SlopeX/Y     contains X/Y slopes              |  C     |            SlopeX/Y     contains X/Y slopes              |
# Line 47  C Line 47  C
47        _RL dSigmaDrS(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL dSigmaDrS(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
48        _RL LrhoW(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL LrhoW(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
49        _RL LrhoS(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL LrhoS(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
50        _RL depthZ        _RL slopeTmpSpec,slopeMaxSpec
51          _RS depthZ
52        INTEGER K,bi,bj,myThid        INTEGER K,bi,bj,myThid
53  CEndOfInterface  CEndOfInterface
54    
# Line 55  CEndOfInterface Line 56  CEndOfInterface
56  #ifdef GM_BOLUS_ADVEC  #ifdef GM_BOLUS_ADVEC
57    
58  C     == Local variables ==  C     == Local variables ==
       _RL gradSmod(1-Olx:sNx+Olx,1-Oly:sNy+Oly)  
59        _RL dSigmaDrLtd(1-Olx:sNx+Olx,1-Oly:sNy+Oly)        _RL dSigmaDrLtd(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
       _RL  SlopeSqr(1-Olx:sNx+Olx,1-Oly:sNy+Oly)  
60        _RL f1,Smod,f2,Rnondim        _RL f1,Smod,f2,Rnondim
61        _RL maxSlopeSqr        _RL maxSlopeSqr
62        _RL slopeCutoff        _RL slopeCutoff
# Line 81  C     == Local variables == Line 80  C     == Local variables ==
80        kkey = (igmkey-1)*Nr + k        kkey = (igmkey-1)*Nr + k
81  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
82    
83    #ifndef GMREDI_WITH_STABLE_ADJOINT
84    c common case:
85    
86        IF (GM_taper_scheme.EQ.'orig' .OR.        IF (GM_taper_scheme.EQ.'orig' .OR.
87       &    GM_taper_scheme.EQ.'clipping') THEN       &    GM_taper_scheme.EQ.'clipping') THEN
88    
# Line 126  CADJ STORE dSigmaDrW(:,:)    = comlev1_b Line 128  CADJ STORE dSigmaDrW(:,:)    = comlev1_b
128          DO j=1-Oly,sNy+Oly          DO j=1-Oly,sNy+Oly
129           DO i=1-Olx+1,sNx+Olx           DO i=1-Olx+1,sNx+Olx
130            SlopeX(i,j) = -SlopeX(i,j)/dSigmaDrW(i,j)            SlopeX(i,j) = -SlopeX(i,j)/dSigmaDrW(i,j)
131            taperX(i,j)=1. _d 0            taperX(i,j) = 1. _d 0
132           ENDDO           ENDDO
133          ENDDO          ENDDO
134    
# Line 161  CADJ STORE dSigmaDrS(:,:)    = comlev1_b Line 163  CADJ STORE dSigmaDrS(:,:)    = comlev1_b
163          DO j=1-Oly+1,sNy+Oly          DO j=1-Oly+1,sNy+Oly
164           DO i=1-Olx,sNx+Olx           DO i=1-Olx,sNx+Olx
165            SlopeY(i,j) = -SlopeY(i,j)/dSigmaDrS(i,j)            SlopeY(i,j) = -SlopeY(i,j)/dSigmaDrS(i,j)
166            taperY(i,j)=1. _d 0            taperY(i,j) = 1. _d 0
167           ENDDO           ENDDO
168          ENDDO          ENDDO
169    
170  #endif /* GM_EXCLUDE_CLIPPING */  #endif /* GM_EXCLUDE_CLIPPING */
171    
172          ELSEIF (GM_taper_scheme.EQ.'fm07') THEN
173    
174            STOP 'GMREDI_SLOPE_PSI: AdvForm not yet implemented for fm07'
175    
176        ELSE        ELSE
177    
178  #ifdef GM_EXCLUDE_TAPERING  #ifdef GM_EXCLUDE_TAPERING
# Line 194  CADJ STORE dsigmadrW(:,:)    = comlev1_b Line 200  CADJ STORE dsigmadrW(:,:)    = comlev1_b
200          DO j=1-Oly,sNy+Oly          DO j=1-Oly,sNy+Oly
201           DO i=1-Olx+1,sNx+Olx           DO i=1-Olx+1,sNx+Olx
202            SlopeX(i,j) = -SlopeX(i,j)/dSigmaDrW(i,j)            SlopeX(i,j) = -SlopeX(i,j)/dSigmaDrW(i,j)
203            taperX(i,j)= 1. _d 0            taperX(i,j) = 1. _d 0
204           ENDDO           ENDDO
205          ENDDO          ENDDO
206  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
# Line 226  CADJ STORE dsigmadrS(:,:)    = comlev1_b Line 232  CADJ STORE dsigmadrS(:,:)    = comlev1_b
232          DO j=1-Oly+1,sNy+Oly          DO j=1-Oly+1,sNy+Oly
233           DO i=1-Olx,sNx+Olx           DO i=1-Olx,sNx+Olx
234            SlopeY(i,j) = -SlopeY(i,j)/dSigmaDrS(i,j)            SlopeY(i,j) = -SlopeY(i,j)/dSigmaDrS(i,j)
235            taperY(i,j)=1. _d 0            taperY(i,j) = 1. _d 0
236           ENDDO           ENDDO
237          ENDDO          ENDDO
238  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
# Line 313  C-      Large, Danabasoglu and Doney, JP Line 319  C-      Large, Danabasoglu and Doney, JP
319           DO i=1-Olx+1,sNx+Olx           DO i=1-Olx+1,sNx+Olx
320            Smod = ABS(SlopeX(i,j))            Smod = ABS(SlopeX(i,j))
321            IF ( Smod .LT. slopeCutoff ) THEN            IF ( Smod .LT. slopeCutoff ) THEN
322            f1=op5*( 1. _d 0 + TANH( (GM_Scrit-Smod)/GM_Sd ))              f1=op5*( 1. _d 0 + TANH( (GM_Scrit-Smod)/GM_Sd ))
323            IF (Smod.NE.0.) THEN              IF (Smod.NE.0.) THEN
324              Rnondim=depthZ/(LrhoW(i,j)*Smod)                Rnondim = -depthZ/(LrhoW(i,j)*Smod)
325            ELSE              ELSE
326              Rnondim=0.                Rnondim = 1.
327            ENDIF              ENDIF
328            f2=op5*( 1. _d 0 + SIN( fpi*(Rnondim-op5)))              IF ( Rnondim.GE.1. _d 0 ) THEN
329            taperX(i,j)=f1*f2                f2 = 1. _d 0
330                ELSE
331                  f2 = op5*( 1. _d 0 + SIN( fpi*(Rnondim-op5) ))
332                ENDIF
333                taperX(i,j)=f1*f2
334            ENDIF            ENDIF
335           ENDDO           ENDDO
336          ENDDO          ENDDO
# Line 329  C-      Large, Danabasoglu and Doney, JP Line 339  C-      Large, Danabasoglu and Doney, JP
339           DO i=1-Olx,sNx+Olx           DO i=1-Olx,sNx+Olx
340            Smod = ABS(SlopeY(i,j))            Smod = ABS(SlopeY(i,j))
341            IF ( Smod .LT. slopeCutoff ) THEN            IF ( Smod .LT. slopeCutoff ) THEN
342            f1=op5*( 1. _d 0 + TANH( (GM_Scrit-Smod)/GM_Sd ))              f1=op5*( 1. _d 0 + TANH( (GM_Scrit-Smod)/GM_Sd ))
343            IF (Smod.NE.0.) THEN              IF (Smod.NE.0.) THEN
344              Rnondim=depthZ/(LrhoS(i,j)*Smod)                Rnondim = -depthZ/(LrhoS(i,j)*Smod)
345            ELSE              ELSE
346              Rnondim=0.                Rnondim = 1.
347            ENDIF              ENDIF
348            f2=op5*( 1. _d 0 + SIN( fpi*(Rnondim-op5)))              IF ( Rnondim.GE.1. _d 0 ) THEN
349            taperY(i,j)=f1*f2                f2 = 1. _d 0
350                ELSE
351                  f2 = op5*( 1. _d 0 + SIN( fpi*(Rnondim-op5) ))
352                ENDIF
353                taperY(i,j)=f1*f2
354            ENDIF            ENDIF
355           ENDDO           ENDDO
356          ENDDO          ENDDO
# Line 349  C-      Large, Danabasoglu and Doney, JP Line 363  C-      Large, Danabasoglu and Doney, JP
363    
364        ENDIF        ENDIF
365    
366    
367    #else  /* GMREDI_WITH_STABLE_ADJOINT */
368    c special choice for adjoint/optimization of parameters
369    c (~ strong clipping, reducing non linearity of psi=f(K))
370    
371    
372    #ifdef ALLOW_AUTODIFF_TAMC
373    CADJ STORE slopeX(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
374    CADJ STORE dSigmaDrW(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
375    #endif
376            DO j=1-Oly,sNy+Oly
377             DO i=1-Olx+1,sNx+Olx
378              IF (dSigmaDrW(i,j).GE.-GM_Small_Number)
379         &        dSigmaDrW(i,j) = -GM_Small_Number
380             ENDDO
381            ENDDO
382    #ifdef ALLOW_AUTODIFF_TAMC
383    CADJ STORE dsigmadrW(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
384    #endif
385            DO j=1-Oly,sNy+Oly
386             DO i=1-Olx+1,sNx+Olx
387              SlopeX(i,j) = -SlopeX(i,j)/dSigmaDrW(i,j)
388              taperX(i,j) = 1. _d 0
389             ENDDO
390            ENDDO
391    
392    #ifdef ALLOW_AUTODIFF_TAMC
393    CADJ STORE slopeY(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
394    CADJ STORE dSigmaDrS(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
395    #endif
396    
397            DO j=1-Oly+1,sNy+Oly
398             DO i=1-Olx,sNx+Olx
399              IF (dSigmaDrS(i,j).GE.-GM_Small_Number)
400         &        dSigmaDrS(i,j) = -GM_Small_Number
401             ENDDO
402            ENDDO
403    #ifdef ALLOW_AUTODIFF_TAMC
404    CADJ STORE dsigmadrS(:,:)    = comlev1_bibj_k, key=kkey, byte=isbyte
405    #endif
406            DO j=1-Oly+1,sNy+Oly
407             DO i=1-Olx,sNx+Olx
408              SlopeY(i,j) = -SlopeY(i,j)/dSigmaDrS(i,j)
409              taperY(i,j) = 1. _d 0
410             ENDDO
411            ENDDO
412    
413            slopeMaxSpec=1. _d -4
414    
415    CADJ STORE slopeX(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
416    CADJ STORE slopeY(:,:)       = comlev1_bibj_k, key=kkey, byte=isbyte
417    
418            DO j=1-Oly,sNy+Oly
419             DO i=1-Olx+1,sNx+Olx
420           slopeTmpSpec=ABS(SlopeX(i,j))
421           IF ( slopeTmpSpec .GT. slopeMaxSpec ) then
422            SlopeX(i,j)=5.*SlopeX(i,j)*slopeMaxSpec/slopeTmpSpec
423           ELSE
424            SlopeX(i,j)=5.*SlopeX(i,j)
425           ENDIF
426           taperX(i,j)=1.
427             ENDDO
428            ENDDO
429            DO j=1-Oly+1,sNy+Oly
430             DO i=1-Olx,sNx+Olx
431           slopeTmpSpec=ABS(SlopeY(i,j))
432           IF ( slopeTmpSpec .GT. slopeMaxSpec ) then
433            SlopeY(i,j)=5.*SlopeY(i,j)*slopeMaxSpec/slopeTmpSpec
434           ELSE
435            SlopeY(i,j)=5.*SlopeY(i,j)
436           ENDIF
437           taperY(i,j)=1.
438             ENDDO
439            ENDDO
440    
441    #endif /* GMREDI_WITH_STABLE_ADJOINT */
442    
443  #endif /* BOLUS_ADVEC */  #endif /* BOLUS_ADVEC */
444  #endif /* ALLOW_GMREDI */  #endif /* ALLOW_GMREDI */
445    
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.11
  ViewVC Help
Powered by ViewVC 1.1.22