[2021] | 1 | module exner_milieu_m |
---|
[1520] | 2 | |
---|
[2021] | 3 | IMPLICIT NONE |
---|
[1520] | 4 | |
---|
[2021] | 5 | contains |
---|
[1520] | 6 | |
---|
[2021] | 7 | SUBROUTINE exner_milieu ( ngrid, ps, p, pks, pk, pkf ) |
---|
| 8 | ! |
---|
| 9 | ! Auteurs : F. Forget , Y. Wanherdrick |
---|
| 10 | ! P.Le Van , Fr. Hourdin . |
---|
| 11 | ! .......... |
---|
| 12 | ! |
---|
| 13 | ! .... ngrid, ps,p sont des argum.d'entree au sous-prog ... |
---|
| 14 | ! .... pks,pk,pkf sont des argum.de sortie au sous-prog ... |
---|
| 15 | ! |
---|
| 16 | ! ************************************************************************ |
---|
| 17 | ! Calcule la fonction d'Exner pk = Cp * (p/preff) ** kappa , aux milieux des |
---|
| 18 | ! couches . Pk(l) sera calcule aux milieux des couches l ,entre les |
---|
| 19 | ! pressions p(l) et p(l+1) ,definis aux interfaces des llm couches . |
---|
| 20 | ! ************************************************************************ |
---|
| 21 | ! .. N.B : Au sommet de l'atmosphere, p(llm+1) = 0. , et ps et pks sont |
---|
| 22 | ! la pression et la fonction d'Exner au sol . |
---|
| 23 | ! |
---|
| 24 | ! WARNING : CECI est une version speciale de exner_hyb originale |
---|
| 25 | ! Utilise dans la version martienne pour pouvoir |
---|
| 26 | ! tourner avec des coordonnees verticales complexe |
---|
| 27 | ! => Il ne verifie PAS la condition la proportionalite en |
---|
| 28 | ! energie totale/ interne / potentielle (F.Forget 2001) |
---|
| 29 | ! ( voir note de Fr.Hourdin ) , |
---|
| 30 | ! |
---|
| 31 | ! |
---|
[2597] | 32 | USE comconst_mod, ONLY: jmp1, cpp, kappa, r |
---|
[2600] | 33 | USE comvert_mod, ONLY: preff |
---|
| 34 | |
---|
[5271] | 35 | USE dimensions_mod, ONLY: iim, jjm, llm, ndm |
---|
| 36 | IMPLICIT NONE |
---|
| 37 | |
---|
| 38 | |
---|
[2021] | 39 | include "paramet.h" |
---|
| 40 | include "comgeom.h" |
---|
[1520] | 41 | |
---|
[2021] | 42 | INTEGER ngrid |
---|
| 43 | REAL p(ngrid,llmp1),pk(ngrid,llm) |
---|
| 44 | real, optional:: pkf(ngrid,llm) |
---|
| 45 | REAL ps(ngrid),pks(ngrid) |
---|
[1520] | 46 | |
---|
[2021] | 47 | ! .... variables locales ... |
---|
| 48 | |
---|
| 49 | INTEGER l, ij |
---|
| 50 | REAL dum1 |
---|
| 51 | |
---|
| 52 | logical,save :: firstcall=.true. |
---|
| 53 | character(len=*),parameter :: modname="exner_milieu" |
---|
| 54 | |
---|
| 55 | ! Sanity check |
---|
| 56 | if (firstcall) then |
---|
| 57 | ! sanity checks for Shallow Water case (1 vertical layer) |
---|
| 58 | if (llm.eq.1) then |
---|
[1520] | 59 | if (kappa.ne.1) then |
---|
[2021] | 60 | call abort_gcm(modname, & |
---|
| 61 | "kappa!=1 , but running in Shallow Water mode!!",42) |
---|
[1520] | 62 | endif |
---|
| 63 | if (cpp.ne.r) then |
---|
[2021] | 64 | call abort_gcm(modname, & |
---|
| 65 | "cpp!=r , but running in Shallow Water mode!!",42) |
---|
[1520] | 66 | endif |
---|
[2021] | 67 | endif ! of if (llm.eq.1) |
---|
[1520] | 68 | |
---|
[2021] | 69 | firstcall=.false. |
---|
| 70 | endif ! of if (firstcall) |
---|
[1520] | 71 | |
---|
[2021] | 72 | ! Specific behaviour for Shallow Water (1 vertical layer) case: |
---|
| 73 | if (llm.eq.1) then |
---|
| 74 | |
---|
| 75 | ! Compute pks(:),pk(:),pkf(:) |
---|
| 76 | |
---|
| 77 | DO ij = 1, ngrid |
---|
| 78 | pks(ij) = (cpp/preff) * ps(ij) |
---|
[1520] | 79 | pk(ij,1) = .5*pks(ij) |
---|
[2021] | 80 | ENDDO |
---|
[1520] | 81 | |
---|
[2021] | 82 | if (present(pkf)) then |
---|
| 83 | pkf = pk |
---|
| 84 | CALL filtreg ( pkf, jmp1, llm, 2, 1, .TRUE., 1 ) |
---|
| 85 | end if |
---|
[1520] | 86 | |
---|
[2021] | 87 | ! our work is done, exit routine |
---|
| 88 | return |
---|
| 89 | endif ! of if (llm.eq.1) |
---|
[1520] | 90 | |
---|
[2021] | 91 | ! General case: |
---|
[1520] | 92 | |
---|
[2021] | 93 | ! ------------- |
---|
| 94 | ! Calcul de pks |
---|
| 95 | ! ------------- |
---|
[1520] | 96 | |
---|
[2021] | 97 | DO ij = 1, ngrid |
---|
| 98 | pks(ij) = cpp * ( ps(ij)/preff ) ** kappa |
---|
| 99 | ENDDO |
---|
[1520] | 100 | |
---|
[2021] | 101 | ! .... Calcul de pk pour la couche l |
---|
| 102 | ! -------------------------------------------- |
---|
| 103 | ! |
---|
| 104 | dum1 = cpp * (2*preff)**(-kappa) |
---|
| 105 | DO l = 1, llm-1 |
---|
| 106 | DO ij = 1, ngrid |
---|
| 107 | pk(ij,l) = dum1 * (p(ij,l) + p(ij,l+1))**kappa |
---|
| 108 | ENDDO |
---|
| 109 | ENDDO |
---|
[1520] | 110 | |
---|
[2021] | 111 | ! .... Calcul de pk pour la couche l = llm .. |
---|
| 112 | ! (on met la meme distance (en log pression) entre Pk(llm) |
---|
| 113 | ! et Pk(llm -1) qu'entre Pk(llm-1) et Pk(llm-2) |
---|
[1520] | 114 | |
---|
[2021] | 115 | DO ij = 1, ngrid |
---|
| 116 | pk(ij,llm) = pk(ij,llm-1)**2 / pk(ij,llm-2) |
---|
| 117 | ENDDO |
---|
[1520] | 118 | |
---|
[2021] | 119 | if (present(pkf)) then |
---|
| 120 | ! calcul de pkf |
---|
| 121 | pkf = pk |
---|
| 122 | CALL filtreg ( pkf, jmp1, llm, 2, 1, .TRUE., 1 ) |
---|
| 123 | end if |
---|
[1520] | 124 | |
---|
[2021] | 125 | END SUBROUTINE exner_milieu |
---|
| 126 | |
---|
| 127 | end module exner_milieu_m |
---|