Back to home page

MITgcm

 
 

    


File indexing completed on 2019-05-01 05:10:52 UTC

view on githubraw file Latest commit f2a88c9f on 2019-04-30 15:14:20 UTC
e4775240e5 Dimi*0001 #include "SALT_PLUME_OPTIONS.h"
6172345053 Dimi*0002 
                0003 CBOP
e4775240e5 Dimi*0004 C     !ROUTINE: SALT_PLUME_FRAC
6172345053 Dimi*0005 C     !INTERFACE:
e4775240e5 Dimi*0006       SUBROUTINE SALT_PLUME_FRAC(
6172345053 Dimi*0007      I                  imax, fact,SPDepth,
1f89baba18 Patr*0008 #ifdef SALT_PLUME_SPLIT_BASIN
                0009      I                  lon,lat,
                0010 #endif
6172345053 Dimi*0011      U                  plumek,
                0012      I                  myTime, myIter, myThid )
762bde3a3e Dimi*0013 
6172345053 Dimi*0014 C     !DESCRIPTION: \bv
                0015 C     *==========================================================*
e4775240e5 Dimi*0016 C     | SUBROUTINE SALT_PLUME_FRAC
6172345053 Dimi*0017 C     | o Compute saltplume penetration.
                0018 C     *==========================================================*
                0019 C     | Compute fraction of saltplume (flux) penetrating to
                0020 C     | specified depth, plumek, due to rejected salt
                0021 C     | during freezing.
                0022 C     | For example, if surface value is Saltplume0,
                0023 C     | and each level gets equal fraction 1/5 down to SPDepth=5,
364f5b7e62 An T*0024 C     | SALT_PLUME_FRAC will report plumek = 1/5,2/5,3/5,4/5,5/5 on
50209c7a98 Jean*0025 C     | output if input plumek = 1,2,3,4,5. Else, output plumek = 0.
6172345053 Dimi*0026 C     | Reference : Duffy et al, (GRL 1999)
                0027 C     |
                0028 C     | =====
                0029 C     | Written by   : ATN (based on SWFRAC)
                0030 C     | Date         : Sep 13, 2007
364f5b7e62 An T*0031 C     | Modified     : Mar 16, 2014 by atn to improve/clean up
50209c7a98 Jean*0032 C     | -> replace 1-[cummulative plumefrac] code which was based
364f5b7e62 An T*0033 C     |    on swfrac with cleaner [cummulative plumefrac] on output
                0034 C     |    in order to avoid 1-[1-[cummulative_plumefrac]] whenever
                0035 C     |    SALT_PLUME_FRAC is called and used from outside.
6172345053 Dimi*0036 C     *==========================================================*
                0037 C     \ev
                0038 
                0039 C     !USES:
                0040       IMPLICIT NONE
824966555a Dimi*0041 #include "SIZE.h"
                0042 #include "SALT_PLUME.h"
6172345053 Dimi*0043 
                0044 C     !INPUT/OUTPUT PARAMETERS:
                0045 C     input arguments
                0046 C     imax    :: number of vertical grid points
                0047 C     fact    :: scale  factor to apply to depth array
                0048 C     SPDpeth :: corresponding SaltPlumeDepth(i,j) at this grid point
                0049 C     myTime  :: Current time in simulation
                0050 C     myIter  :: Current iteration number in simulation
                0051 C     myThid  :: My Thread Id. number
                0052       INTEGER imax
                0053       _RL     fact
                0054       _RL     myTime
                0055       INTEGER myIter
                0056       INTEGER myThid
                0057 C     input/output arguments
                0058 C     plumek :: on input: vertical depth for desired plume fraction
                0059 C               (fact*plumek) is negative distance (m) from surface
                0060 C     plumek :: on output: saltplume contribution fraction
                0061       _RL     plumek(imax), SPDepth(imax)
1f89baba18 Patr*0062 #ifdef SALT_PLUME_SPLIT_BASIN
                0063       _RL     lon(imax), lat(imax)
                0064 #endif
762bde3a3e Dimi*0065 CEOP
                0066 
                0067 #ifdef ALLOW_SALT_PLUME
6172345053 Dimi*0068 C     !LOCAL VARIABLES:
824966555a Dimi*0069       _RL facz, dd, dd20
1f89baba18 Patr*0070       INTEGER i, Npowerloc
f2a88c9ff8 jm-c 0071 c     INTEGER kk
364f5b7e62 An T*0072       _RL     one, two, three, S, So, zero
5968a91b01 An T*0073       parameter( one = 1. _d 0, two = 2. _d 0, three = 3. _d 0 )
364f5b7e62 An T*0074       parameter( zero = 0. _d 0 )
6d26a6f379 Mart*0075 C     This is an abbreviation of 1./(exp(1.)-1.)
                0076       _RL     recip_expOneM1
                0077       parameter( recip_expOneM1 = 0.581976706869326343 )
6172345053 Dimi*0078 
                0079       DO i = 1,imax
54ce47f4c7 Mart*0080        facz = abs(fact*plumek(i))
1f89baba18 Patr*0081 #ifdef SALT_PLUME_SPLIT_BASIN
                0082        IF(SaltPlumeSplitBasin) THEN
                0083          Npowerloc = Npower(2)
                0084          IF(lat(imax).LT. 85.0 .AND. lat(imax).GT. 71.0
                0085      &      .AND. lon(imax) .LT. -90.0) Npowerloc = Npower(1)
                0086        ELSE
                0087          Npowerloc = Npower(1)
                0088        ENDIF
                0089 #else
                0090          Npowerloc = Npower
                0091 #endif
364f5b7e62 An T*0092 
                0093        IF (SPDepth(i).GE.facz .and. SPDepth(i) .GT. zero) THEN
824966555a Dimi*0094 
5968a91b01 An T*0095 C     Default: uniform distribution, PlumeMethod=1, Npower=0
54ce47f4c7 Mart*0096         IF (PlumeMethod .EQ. 1) THEN
                0097          dd20 = (abs(SPDepth(i)))
f2a88c9ff8 jm-c 0098 c#ifdef TARGET_NEC_SX
                0099 C     This rewriting (originally for TARGET_NEC_SX) is better for all platforms
364f5b7e62 An T*0100          IF ( dd20 .GT. zero ) THEN
                0101           S   = (facz/dd20)
                0102 C     crazy attempt to make the code faster and raise S to (Npower+1)
1f89baba18 Patr*0103           IF (Npowerloc .GT. 0) S = S*S**Npowerloc
54ce47f4c7 Mart*0104          ELSE
364f5b7e62 An T*0105           S = zero
54ce47f4c7 Mart*0106          ENDIF
364f5b7e62 An T*0107          plumek(i) = max(zero,S)
f2a88c9ff8 jm-c 0108 c#else
                0109 c        S  = one                  !input depth temp
                0110 c        So = one
                0111 c        DO kk=1,Npowerloc+1
                0112 c         S  = facz*S              !raise to the Npowerloc+1
                0113 c         So = dd20*So
                0114 c        ENDDO
                0115 c        plumek(i) = max(zero,S/So)
                0116 c#endif /* TARGET_NEC_SX */
5968a91b01 An T*0117 
54ce47f4c7 Mart*0118         ELSEIF (PlumeMethod .EQ. 2) THEN !exponential distribution
                0119          dd = abs(SPDepth(i))
364f5b7e62 An T*0120          S  = exp(facz/dd)-one
                0121          So = recip_expOneM1       !So = exp(one)-one
                0122          plumek(i) = max(zero,S*So)
5968a91b01 An T*0123 
50209c7a98 Jean*0124 C     PlumeMethod = 3, distribute salt LINEARLY between SPDepth and
54ce47f4c7 Mart*0125 C     SPDepth/SPovershoot
364f5b7e62 An T*0126 C     (1-SPovershoot)percent has already been taken into account in
                0127 C     SPDepth calculation, i.e., SPDepth = SPovershoot*SPDepth.
54ce47f4c7 Mart*0128         ELSEIF (PlumeMethod .EQ. 3) THEN !overshoot 20%
                0129          dd20 = (abs(SPDepth(i)))
                0130          dd   = dd20/SPovershoot
364f5b7e62 An T*0131          So=dd20-dd
                0132          S =facz-dd
54ce47f4c7 Mart*0133          IF( (facz.GE.dd).AND.(facz.LT.dd20) ) THEN
364f5b7e62 An T*0134           plumek(i) = max(zero,S/So)
54ce47f4c7 Mart*0135          ELSE
364f5b7e62 An T*0136           plumek(i) = zero
54ce47f4c7 Mart*0137          ENDIF
364f5b7e62 An T*0138 
5968a91b01 An T*0139 C     PlumeMethod = 5, dumping all salt at the top layer
54ce47f4c7 Mart*0140         ELSEIF (PlumeMethod .EQ. 5) THEN
364f5b7e62 An T*0141          dd   = zero
54ce47f4c7 Mart*0142          dd20 = one
                0143          IF( (facz.GE.dd).AND.(facz.LT.dd20) ) THEN
50209c7a98 Jean*0144           plumek(i) = zero
54ce47f4c7 Mart*0145          ELSE
364f5b7e62 An T*0146           plumek(i) = one
54ce47f4c7 Mart*0147          ENDIF
                0148         ELSEIF (PlumeMethod .EQ. 6) THEN
5968a91b01 An T*0149 C     PLumeMethod = 6, currently only works for Npower = 1 and 2.
54ce47f4c7 Mart*0150          dd20 = (abs(SPDepth(i)))
f2a88c9ff8 jm-c 0151 c#ifdef TARGET_NEC_SX
                0152 C     This rewriting (originally for TARGET_NEC_SX) is better for all platforms
364f5b7e62 An T*0153          IF ( dd20 .GT. zero ) THEN
                0154           S  = (facz/dd20)
                0155 C     crazy attempt to make the code faster and raise S to (Npower+1)
1f89baba18 Patr*0156           IF (Npowerloc .GT. 0) S = S*S**Npowerloc
364f5b7e62 An T*0157           So = 1. _d 0/dd20
6172345053 Dimi*0158          ELSE
364f5b7e62 An T*0159           S  = zero
                0160           So = zero
54ce47f4c7 Mart*0161          ENDIF
1f89baba18 Patr*0162          IF(Npowerloc.EQ.1) THEN   !Npower=1
364f5b7e62 An T*0163           plumek(i) = max(zero,two*So*facz-S)
                0164          ELSE                      !Npower=2
                0165           plumek(i) = max(zero,
                0166      &         three*So*facz - three*So*So*facz*facz + S)
6172345053 Dimi*0167          ENDIF
f2a88c9ff8 jm-c 0168 c#else
                0169 c        S  = one                  !input depth temp
                0170 c        So = one
                0171 c        DO kk=1,Npowerloc+1
                0172 c         S  = facz*S              !raise to the Npower+1
                0173 c         So = dd20*So
                0174 c        ENDDO
                0175 c        IF(Npowerloc.EQ.1) THEN   !Npower=1
                0176 c         plumek(i) = max(zero,two/dd20*facz-S/So)
                0177 c        ELSE                      !Npower=2
                0178 c         plumek(i) = max(zero,
                0179 c    &         three/dd20*facz - three/(dd20*dd20)*facz*facz + S/So)
                0180 c        ENDIF
                0181 c#endif /* TARGET_NEC_SX */
50209c7a98 Jean*0182 
364f5b7e62 An T*0183 catn: 15.Mar.2014
                0184 catn: this is a new method by atn. After fixing adjoint compiling error,
50209c7a98 Jean*0185 catn: will switch this on.  Currently commenting out for purpose of
364f5b7e62 An T*0186 catn: comparing old (1-abc) vs new (abc) way of coding
50209c7a98 Jean*0187 c        ELSEIF (PlumeMethod .EQ. 7) THEN
364f5b7e62 An T*0188 cC     PLumeMethod = 7, dump an offset parabolla with more salt at surface
                0189 cC        tapered to zero at depth SPDepth/2, then increased until SPDepth
                0190 cC        need input SPDepth, NPower = percentage of SPDepth
                0191 cC        Ex: if Npower = 10 -> (10/2)=5% of SPDepth
                0192 cC        NPower can be negative integer here.
                0193 cC        0 -> parabola centered at SPDepth/2;
                0194 cC        + -> parabola offset, salt @ surface < @ SPDepth
                0195 cC        - -> parabola offset, salt @ surface > @ SPDepth
                0196 cC        S and So are dummy variables
                0197 c         dd   = (abs(SPDepth(i)))
                0198 c         dd20 = dd*(one/two-Npower/200. _d 0)
                0199 c         So   = (dd*dd*dd/three)
                0200 c     &            -(dd*dd)      *dd20
                0201 c     &            +(dd)         *dd20*dd20
                0202 c         S    = (facz*facz *facz/three)
                0203 c     &             - (facz*facz)*dd20
                0204 c     &             + (facz)     *dd20*dd20
                0205 c         plumek(i) = max(zero,(S/So))
                0206 c
54ce47f4c7 Mart*0207         ELSE
50209c7a98 Jean*0208          plumek(i) = one
                0209 #ifndef TARGET_NEC_SX
54ce47f4c7 Mart*0210          WRITE(*,*) 'salt_plume_frac: PLumeMethod =', PLumeMethod,
                0211      &        'not implemented'
                0212          STOP 'ABNORMAL in S/R SALT_PLUME_FRAC'
                0213 #endif /* not TARGET_NEC_SX */
                0214         ENDIF
                0215        ELSE
364f5b7e62 An T*0216         plumek(i) = one
54ce47f4c7 Mart*0217        ENDIF
6172345053 Dimi*0218       ENDDO
50209c7a98 Jean*0219 
762bde3a3e Dimi*0220 #endif /* ALLOW_SALT_PLUME */
                0221 
6172345053 Dimi*0222       RETURN
                0223       END