| 1 | SUBROUTINE watercloud(ngrid,nlay, ptimestep, |
|---|
| 2 | & pplev,pplay,pdpsrf,pzlev,pzlay,pt,pdt, |
|---|
| 3 | & pq,pdq,pdqcloud,pdtcloud, |
|---|
| 4 | & nq,tau,tauscaling,rdust,rice,nuice, |
|---|
| 5 | & rsedcloud,rhocloud) |
|---|
| 6 | IMPLICIT NONE |
|---|
| 7 | |
|---|
| 8 | c======================================================================= |
|---|
| 9 | c Water-ice cloud formation |
|---|
| 10 | c |
|---|
| 11 | c Includes two different schemes: |
|---|
| 12 | c - A simplified scheme (see simpleclouds.F) |
|---|
| 13 | c - An improved microphysical scheme (see improvedclouds.F) |
|---|
| 14 | c |
|---|
| 15 | c Authors: Franck Montmessin, Francois Forget, Ehouarn Millour, |
|---|
| 16 | c J.-B. Madeleine, Thomas Navarro |
|---|
| 17 | c |
|---|
| 18 | c 2004 - Oct. 2011 |
|---|
| 19 | c======================================================================= |
|---|
| 20 | |
|---|
| 21 | c----------------------------------------------------------------------- |
|---|
| 22 | c declarations: |
|---|
| 23 | c ------------- |
|---|
| 24 | |
|---|
| 25 | #include "dimensions.h" |
|---|
| 26 | #include "dimphys.h" |
|---|
| 27 | #include "comcstfi.h" |
|---|
| 28 | #include "callkeys.h" |
|---|
| 29 | #include "tracer.h" |
|---|
| 30 | #include "comgeomfi.h" |
|---|
| 31 | #include "dimradmars.h" |
|---|
| 32 | |
|---|
| 33 | c Inputs: |
|---|
| 34 | c ------ |
|---|
| 35 | |
|---|
| 36 | INTEGER ngrid,nlay |
|---|
| 37 | integer nq ! nombre de traceurs |
|---|
| 38 | REAL ptimestep ! pas de temps physique (s) |
|---|
| 39 | REAL pplev(ngrid,nlay+1) ! pression aux inter-couches (Pa) |
|---|
| 40 | REAL pplay(ngrid,nlay) ! pression au milieu des couches (Pa) |
|---|
| 41 | REAL pdpsrf(ngrid) ! tendance surf pressure |
|---|
| 42 | REAL pzlev(ngrid,nlay+1) ! altitude at layer boundaries |
|---|
| 43 | REAL pzlay(ngrid,nlay) ! altitude at the middle of the layers |
|---|
| 44 | REAL pt(ngrid,nlay) ! temperature at the middle of the layers (K) |
|---|
| 45 | REAL pdt(ngrid,nlay) ! tendance temperature des autres param. |
|---|
| 46 | |
|---|
| 47 | real pq(ngrid,nlay,nq) ! traceur (kg/kg) |
|---|
| 48 | real pdq(ngrid,nlay,nq) ! tendance avant condensation (kg/kg.s-1) |
|---|
| 49 | |
|---|
| 50 | REAL tau(ngridmx,naerkind) ! Column dust optical depth at each point |
|---|
| 51 | REAL tauscaling(ngridmx) ! Convertion factor for dust amount |
|---|
| 52 | real rdust(ngridmx,nlayermx) ! Dust geometric mean radius (m) |
|---|
| 53 | |
|---|
| 54 | c Outputs: |
|---|
| 55 | c ------- |
|---|
| 56 | |
|---|
| 57 | real pdqcloud(ngrid,nlay,nq) ! tendance de la condensation H2O(kg/kg.s-1) |
|---|
| 58 | REAL pdtcloud(ngrid,nlay) ! tendance temperature due |
|---|
| 59 | ! a la chaleur latente |
|---|
| 60 | |
|---|
| 61 | REAL rice(ngrid,nlay) ! Ice mass mean radius (m) |
|---|
| 62 | ! (r_c in montmessin_2004) |
|---|
| 63 | REAL nuice(ngrid,nlay) ! Estimated effective variance |
|---|
| 64 | ! of the size distribution |
|---|
| 65 | real rsedcloud(ngridmx,nlayermx) ! Cloud sedimentation radius |
|---|
| 66 | real rhocloud(ngridmx,nlayermx) ! Cloud density (kg.m-3) |
|---|
| 67 | |
|---|
| 68 | c local: |
|---|
| 69 | c ------ |
|---|
| 70 | |
|---|
| 71 | INTEGER ig,l |
|---|
| 72 | LOGICAL,SAVE :: firstcall=.true. |
|---|
| 73 | |
|---|
| 74 | c ** un petit test de coherence |
|---|
| 75 | c -------------------------- |
|---|
| 76 | |
|---|
| 77 | IF (firstcall) THEN |
|---|
| 78 | IF(ngrid.NE.ngridmx) THEN |
|---|
| 79 | PRINT*,'STOP dans watercloud' |
|---|
| 80 | PRINT*,'probleme de dimensions :' |
|---|
| 81 | PRINT*,'ngrid =',ngrid |
|---|
| 82 | PRINT*,'ngridmx =',ngridmx |
|---|
| 83 | STOP |
|---|
| 84 | ENDIF |
|---|
| 85 | |
|---|
| 86 | if (nq.gt.nqmx) then |
|---|
| 87 | write(*,*) 'stop in watercloud (nq.gt.nqmx)!' |
|---|
| 88 | write(*,*) 'nq=',nq,' nqmx=',nqmx |
|---|
| 89 | stop |
|---|
| 90 | endif |
|---|
| 91 | |
|---|
| 92 | write(*,*) "watercloud: igcm_h2o_vap=",igcm_h2o_vap |
|---|
| 93 | write(*,*) " igcm_h2o_ice=",igcm_h2o_ice |
|---|
| 94 | |
|---|
| 95 | firstcall=.false. |
|---|
| 96 | ENDIF ! of IF (firstcall) |
|---|
| 97 | |
|---|
| 98 | |
|---|
| 99 | c Main call to the different cloud schemes: |
|---|
| 100 | IF (microphys) THEN |
|---|
| 101 | CALL improvedclouds(ngrid,nlay,ptimestep, |
|---|
| 102 | & pplev,pplay,pt,pdt, |
|---|
| 103 | & pq,pdq,pdqcloud,pdtcloud, |
|---|
| 104 | & nq,tauscaling,rdust,rice,nuice, |
|---|
| 105 | & rsedcloud,rhocloud) |
|---|
| 106 | ELSE |
|---|
| 107 | CALL simpleclouds(ngrid,nlay,ptimestep, |
|---|
| 108 | & pplev,pplay,pzlev,pzlay,pt,pdt, |
|---|
| 109 | & pq,pdq,pdqcloud,pdtcloud, |
|---|
| 110 | & nq,tau,rice,nuice,rsedcloud) |
|---|
| 111 | ENDIF |
|---|
| 112 | |
|---|
| 113 | |
|---|
| 114 | c A correction if a lot of subliming CO2 fills the 1st layer FF04/2005 |
|---|
| 115 | c ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
|---|
| 116 | c Then that should not affect the ice particle radius |
|---|
| 117 | do ig=1,ngridmx |
|---|
| 118 | if(pdpsrf(ig)*ptimestep.gt.0.9*(pplev(ig,1)-pplev(ig,2)))then |
|---|
| 119 | if(pdpsrf(ig)*ptimestep.gt.0.9*(pplev(ig,1)-pplev(ig,3))) |
|---|
| 120 | & rice(ig,2)=rice(ig,3) |
|---|
| 121 | rice(ig,1)=rice(ig,2) |
|---|
| 122 | end if |
|---|
| 123 | end do |
|---|
| 124 | |
|---|
| 125 | RETURN |
|---|
| 126 | END |
|---|
| 127 | |
|---|
