source: trunk/WRF.COMMON/WRFV3/phys/module_sf_sfcdiags.F @ 3431

Last change on this file since 3431 was 2759, checked in by aslmd, 2 years ago

adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size

File size: 2.3 KB
Line 
1!WRF:MODEL_LAYER:PHYSICS
2!
3MODULE module_sf_sfcdiags
4
5CONTAINS
6
7   SUBROUTINE SFCDIAGS(HFX,QFX,TSK,QSFC,CHS2,CQS2,T2,TH2,Q2,       &
8                     PSFC,CP,R_d,ROVCP,                            &
9                     ids,ide, jds,jde, kds,kde,                    &
10                     ims,ime, jms,jme, kms,kme,                    &
11                     its,ite, jts,jte, kts,kte                     )
12!-------------------------------------------------------------------
13      IMPLICIT NONE
14!-------------------------------------------------------------------
15      INTEGER,  INTENT(IN )   ::        ids,ide, jds,jde, kds,kde, &
16                                        ims,ime, jms,jme, kms,kme, &
17                                        its,ite, jts,jte, kts,kte
18      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
19                INTENT(IN)                  ::                HFX, &
20                                                              QFX, &
21                                                              TSK, &
22                                                             QSFC
23      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
24                INTENT(INOUT)               ::                Q2, &
25                                                             TH2, &
26                                                              T2
27      REAL,     DIMENSION( ims:ime, jms:jme )                    , &
28                INTENT(IN)                  ::               PSFC, &
29                                                             CHS2, &
30                                                             CQS2
31      REAL,     INTENT(IN   )               ::       CP,R_d,ROVCP
32! LOCAL VARS
33      INTEGER ::  I,J
34      REAL    ::  RHO
35
36      DO J=jts,jte
37        DO I=its,ite
38          RHO = PSFC(I,J)/(R_d * TSK(I,J))
39          if(CQS2(I,J).lt.1.E-5) then
40             Q2(I,J)=QSFC(I,J)
41          else
42             Q2(I,J) = QSFC(I,J) - QFX(I,J)/(RHO*CQS2(I,J))
43          endif
44          if(CHS2(I,J).lt.1.E-5) then
45             T2(I,J) = TSK(I,J)
46          else
47             T2(I,J) = TSK(I,J) - HFX(I,J)/(RHO*CP*CHS2(I,J))
48          endif
49          TH2(I,J) = T2(I,J)*(1.E5/PSFC(I,J))**ROVCP
50        ENDDO
51      ENDDO
52
53  END SUBROUTINE SFCDIAGS
54
55END MODULE module_sf_sfcdiags
Note: See TracBrowser for help on using the repository browser.