| 1 | MODULE gwprofil_mod |
|---|
| 2 | |
|---|
| 3 | IMPLICIT NONE |
|---|
| 4 | |
|---|
| 5 | CONTAINS |
|---|
| 6 | |
|---|
| 7 | SUBROUTINE GWPROFIL( ngrid, nlayer, kgwd ,kdx, ktest, & |
|---|
| 8 | IKCRITH, ICRIT, IKENVH, IKNU,IKNU2,pplev, & |
|---|
| 9 | ZRHO, BV, ZVPH, PRI,zdmod, psig , pvar, & |
|---|
| 10 | !not used variables |
|---|
| 11 | !IKCRIT,ZTAUf,ZTFR,znu,pgam, |
|---|
| 12 | ! in-output |
|---|
| 13 | ZTAU ) |
|---|
| 14 | |
|---|
| 15 | !--------------------------------------------------------------------------- |
|---|
| 16 | ! THe stress profile for gravity waves is computed as follows: |
|---|
| 17 | ! It is constant (no GWD) at the levels between the ground and |
|---|
| 18 | ! the top of the blocked layer (IKENVH). It decreases linearly |
|---|
| 19 | ! with heights from the top of the blocked layer to 3*varor(IKNU) |
|---|
| 20 | ! to simulates lee waves or nonlinear gravity wave breaking. |
|---|
| 21 | ! Above it is constant, except when the wave encounters a critical |
|---|
| 22 | ! level(ICRIT) or when it breaks.! |
|---|
| 23 | ! PASSAGE OF THE NEW GWDRAG TO I.F.S. (F. LOTT, 22/11/93) |
|---|
| 24 | ! REFERENCE. |
|---|
| 25 | ! SEE ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE "I.F.S." |
|---|
| 26 | ! MODIFICATIONS. |
|---|
| 27 | ! Rewrited by J.Liu 03/03/2022 |
|---|
| 28 | !--------------------------------------------------------------------------- |
|---|
| 29 | |
|---|
| 30 | use dimradmars_mod, only: ndomainsz |
|---|
| 31 | implicit none |
|---|
| 32 | #include "yoegwd.h" ! why begin with #, needs ask Ehouarn Millour |
|---|
| 33 | |
|---|
| 34 | ! 0. DECLARATIONS: |
|---|
| 35 | ! 0.1 ARGUMENTS |
|---|
| 36 | integer, intent(in):: ngrid ! Number of atmospheric columns |
|---|
| 37 | integer, intent(in):: nlayer ! Number of atmospheric layers |
|---|
| 38 | INTEGER, intent(in) :: kgwd ! Number of points at which the scheme is called |
|---|
| 39 | ! INTEGER, INTENT(IN) :: IKCRIT(ndomainsz ) ! Top of low level flow height (not used) |
|---|
| 40 | INTEGER, INTENT(IN) :: IKCRITH(ndomainsz ) ! dynamical mixing height for the breaking of gravity waves |
|---|
| 41 | INTEGER, INTENT(IN) :: ICRIT(ndomainsz ) ! Critical layer where orographic GW breaks |
|---|
| 42 | INTEGER, INTENT(IN) :: kdx(ndomainsz ) ! Points at which to call the scheme |
|---|
| 43 | INTEGER, INTENT(IN) :: ktest(ndomainsz ) ! Map of calling points |
|---|
| 44 | INTEGER, INTENT(IN) :: IKENVH(ndomainsz ) ! Top of the blocked layer |
|---|
| 45 | INTEGER, INTENT(IN) :: IKNU(ndomainsz ) ! 4*pvar layer |
|---|
| 46 | INTEGER, INTENT(IN) :: IKNU2(ndomainsz ) ! 3*pvar layer |
|---|
| 47 | |
|---|
| 48 | REAL, INTENT(IN):: pplev(ndomainsz ,nlayer+1) ! Pressure at 1/2 levels(Pa) |
|---|
| 49 | REAL, INTENT(IN):: BV(ndomainsz ,nlayer+1) ! Brunt–Väisälä frequency at 1/2 level (output from OROSETUP input for GWSTRESS and GWPROFIL) |
|---|
| 50 | REAL, INTENT(IN):: ZRHO (ndomainsz ,nlayer+1) ! Atmospheric density at 1/2 level |
|---|
| 51 | REAL, INTENT(IN):: ZVPH (ndomainsz ,nlayer+1) ! SUB-GRID SCALE STANDARD DEVIATION at 1/2 level |
|---|
| 52 | REAL, INTENT(IN):: PRI (ndomainsz ,nlayer+1) ! Mean flow richardson number at 1/2 level |
|---|
| 53 | ! REAL, INTENT(IN):: ZTFR (ndomainsz ) ! not used |
|---|
| 54 | ! REAL, INTENT(IN):: ZTAUf (ndomainsz ,nlayer+1) ! not used |
|---|
| 55 | ! |
|---|
| 56 | REAL, INTENT(IN):: zdmod (ndomainsz ) |
|---|
| 57 | ! REAL, INTENT(IN):: znu (ndomainsz ) ! not used |
|---|
| 58 | REAL, INTENT(IN):: psig(ndomainsz ) ! Sub-grid scale slope |
|---|
| 59 | ! REAL, INTENT(IN):: pgam(ndomainsz ) ! Sub-grid scale anisotropy(not used) |
|---|
| 60 | REAL, INTENT(IN):: pvar(ndomainsz ) ! Sub-grid scale standard deviation |
|---|
| 61 | REAL, INTENT(inout):: ZTAU(ndomainsz ,nlayer+1) ! Gravity waves induced stress |
|---|
| 62 | |
|---|
| 63 | ! 0.2 LOCAL ARRAYS |
|---|
| 64 | real zsqr,zalfa,zriw,zalpha,zb,zdel,zdz2n,zdelp,zdelpt |
|---|
| 65 | integer ji,jk,jl,ilevh |
|---|
| 66 | REAL ZDZ2 (ndomainsz ,nlayer) , ZNORM(ndomainsz ) , zoro(ndomainsz ) |
|---|
| 67 | REAL Z_TAU (ndomainsz ,nlayer+1) |
|---|
| 68 | |
|---|
| 69 | !----------------------------------------------------------------------- |
|---|
| 70 | !* 1. Initialization |
|---|
| 71 | !----------------------------------------------------------------------- |
|---|
| 72 | ! kidia=1 |
|---|
| 73 | ! kfdia=ngrid |
|---|
| 74 | 100 CONTINUE |
|---|
| 75 | ! 1.1 Computional constants . |
|---|
| 76 | ilevh=nlayer/3 |
|---|
| 77 | |
|---|
| 78 | DO ji=1,kgwd |
|---|
| 79 | jl=kdx(ji) |
|---|
| 80 | Zoro(JL)=psig(JL)*zdmod(JL)/4./max(pvar(jl),1.0) |
|---|
| 81 | Z_TAU(JL,IKNU(JL)+1)=ZTAU(JL,IKNU(JL)+1) |
|---|
| 82 | Z_TAU(JL,nlayer+1)=ZTAU(JL,nlayer+1) |
|---|
| 83 | ENDDO |
|---|
| 84 | |
|---|
| 85 | ! all start here with this long loop |
|---|
| 86 | DO JK=nlayer,2,-1 |
|---|
| 87 | ! 4.1 Constant wave stress until top of the blocking layer |
|---|
| 88 | 410 CONTINUE |
|---|
| 89 | DO ji=1,kgwd |
|---|
| 90 | jl=kdx(ji) |
|---|
| 91 | IF(JK.GE.IKNU2(JL)) THEN |
|---|
| 92 | ZTAU(JL,JK)=Z_TAU(JL,nlayer+1) |
|---|
| 93 | ENDIF |
|---|
| 94 | ENDDO |
|---|
| 95 | |
|---|
| 96 | !* 4.15 Constant shear stress until the top of the low level flow layer |
|---|
| 97 | 415 CONTINUE |
|---|
| 98 | ! 4.2 Wave displacement at next level. |
|---|
| 99 | 420 CONTINUE |
|---|
| 100 | |
|---|
| 101 | DO ji=1,kgwd |
|---|
| 102 | jl=kdx(ji) |
|---|
| 103 | IF(JK.LT.IKNU2(JL)) THEN |
|---|
| 104 | ZNORM(JL)=gkdrag*ZRHO(JL,JK)*SQRT(BV(JL,JK))*ZVPH(JL,JK)*zoro(jl) |
|---|
| 105 | ZDZ2(JL,JK)=ZTAU(JL,JK+1)/max(ZNORM(JL),gssec) |
|---|
| 106 | ENDIF |
|---|
| 107 | ENDDO |
|---|
| 108 | |
|---|
| 109 | ! 4.3 Wave Richardson number, new wave displacement and stress: |
|---|
| 110 | ! Breaking evaluation and critical level C |
|---|
| 111 | DO ji=1,kgwd |
|---|
| 112 | jl=kdx(ji) |
|---|
| 113 | IF(JK.LT.IKNU2(JL)) THEN |
|---|
| 114 | IF((ZTAU(JL,JK+1).LT.GTSEC).OR.(JK.LE.ICRIT(JL))) THEN |
|---|
| 115 | ZTAU(JL,JK)=0.0 |
|---|
| 116 | ELSE |
|---|
| 117 | ZSQR=SQRT(PRI(JL,JK)) |
|---|
| 118 | ZALFA=SQRT(BV(JL,JK)*ZDZ2(JL,JK))/ZVPH(JL,JK) |
|---|
| 119 | ZRIW=PRI(JL,JK)*(1.-ZALFA)/(1+ZALFA*ZSQR)**2 |
|---|
| 120 | IF(ZRIW.LT.GRCRIT) THEN |
|---|
| 121 | ZDEL=4./ZSQR/GRCRIT+1./GRCRIT**2+4./GRCRIT |
|---|
| 122 | ZB=1./GRCRIT+2./ZSQR |
|---|
| 123 | ZALPHA=0.5*(-ZB+SQRT(ZDEL)) |
|---|
| 124 | ZDZ2N=(ZVPH(JL,JK)*ZALPHA)**2/BV(JL,JK) |
|---|
| 125 | ZTAU(JL,JK)=ZNORM(JL)*ZDZ2N |
|---|
| 126 | ELSE |
|---|
| 127 | ZTAU(JL,JK)=ZNORM(JL)*ZDZ2(JL,JK) |
|---|
| 128 | ENDIF |
|---|
| 129 | ZTAU(JL,JK)=MIN(ZTAU(JL,JK),ZTAU(JL,JK+1)) |
|---|
| 130 | ENDIF |
|---|
| 131 | ENDIF |
|---|
| 132 | ENDDO |
|---|
| 133 | end DO !JK=nlayer,2,-1 |
|---|
| 134 | !------------------------------------------------------------------------------------------- |
|---|
| 135 | |
|---|
| 136 | 440 CONTINUE |
|---|
| 137 | |
|---|
| 138 | ! write(*,*) 'ZTAU' |
|---|
| 139 | ! write(*,99) ((ji,ilevh,ZTAU(ji,ilevh),ji=1,ndomainsz ), |
|---|
| 140 | ! . ilevh=1,nlayer+1) |
|---|
| 141 | 99 FORMAT(i3,i3,f15.5) ! not used |
|---|
| 142 | |
|---|
| 143 | ! Proganisation of the stress profile if breaking occurs at low level |
|---|
| 144 | DO ji=1,kgwd |
|---|
| 145 | jl=kdx(ji) |
|---|
| 146 | Z_TAU(JL,IKENVH(JL))=ZTAU(JL,IKENVH(JL)) |
|---|
| 147 | Z_TAU(JL,IKCRITH(JL))=ZTAU(JL,IKCRITH(JL)) |
|---|
| 148 | ENDDO |
|---|
| 149 | |
|---|
| 150 | DO JK=1,nlayer |
|---|
| 151 | DO ji=1,kgwd |
|---|
| 152 | jl=kdx(ji) |
|---|
| 153 | IF(JK.GT.IKCRITH(JL).AND.JK.LT.IKENVH(JL))THEN |
|---|
| 154 | ZDELP=pplev(JL,JK)-pplev(JL,IKENVH(JL)) |
|---|
| 155 | ZDELPT=pplev(JL,IKCRITH(JL))-pplev(JL,IKENVH(JL)) |
|---|
| 156 | ZTAU(JL,JK)=Z_TAU(JL,IKENVH(JL))+(Z_TAU(JL,IKCRITH(JL))-Z_TAU(JL,IKENVH(JL)))*ZDELP/ZDELPT |
|---|
| 157 | ENDIF |
|---|
| 158 | ENDDO |
|---|
| 159 | end DO |
|---|
| 160 | |
|---|
| 161 | END SUBROUTINE GWPROFIL |
|---|
| 162 | |
|---|
| 163 | END MODULE gwprofil_mod |
|---|
