ext_lam_synop.f90 6.58 KB
Newer Older
Paulo V C Medeiros's avatar
Paulo V C Medeiros committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
  subroutine EXT_LAM_SYNOP(CLDATE,CINDIC,ZLATA,ZLONA,ZALTA,rval)

!-----------------------------------------------------------------------
! SUBROUTINE EXT_LAM_SYNOP(CLDATE,CINDIC,ZLATA,ZLONA,ZALTA,
!                    ZPMERA,ZPSTAA,ZT2M,ZDEW2M,ZDIR,ZWSP,ZRH,ZPRE,ZSNOW)
!                      6       5    1     3     8    7    2    9    4
! call EXT_LAM_SYNOP(cval_date,INDIC,rval_lat,rval_lon,rval_hei,rval)
!-----------------------------------------------------------------------

  implicit none

  integer, parameter :: npar=13,nvar=15,NABSI=999999

  real, parameter :: RG=9.80665,ZALTSY=500.,RABSI=1.70E+38,undef=999999.

  integer :: IDAT,IDATE,IETM,INBP,INLV,IOCH,IOTP,IPRESCD,IRFL,IRLN,ISTD,ivar,NABSO

  integer, dimension(nvar) :: IVNM,IFLG

  real, external :: ew
  real :: ZLATA,ZLONA,ZALTA,ZLAT,ZLON,ZALT
  real :: ZPMERA,ZPSTAA,ZT2M,ZDEW2M,ZDIR,ZWSP,ZRH,ZSNOW
  real :: ZPMER,ZPSTA,ZT,ZTD,ZHU
  real :: RABSO

  real,dimension(npar) :: rval
  real,dimension(nvar) :: ZPOB,ZPRL,ZVAR

  character(len=8) :: CINDIC
  character(len=10) :: CLDATE
  character(len=11) :: CLINDIC
  character(len=12) :: CLLAT,CLLON

  NABSO = NABSI
  RABSO = RABSI

  IDAT = NABSO
  IETM = NABSO
  INLV = NABSO
  IRLN = NABSO

  DO ivar=1,nvar
  IVNM(ivar) = NABSO
  ZPOB(ivar) = RABSO
  ZPRL(ivar) = RABSO
  ZVAR(ivar) = RABSO
  IFLG(ivar) = NABSO
  ENDDO

!-----------------------------------------------------------------------
!       PARAMETERS  - Set to a fixed value which is never changed
!-----------------------------------------------------------------------

  IOTP = 1             ! OBSTYPE : 1 = Land SYNOP and SHIP reports
  IOCH = 14            ! Code type for SYNOP : 14 = SYNOP land manual
  IRFL = 1111          ! Observation quality flag [Assigned by program OULAN]

!-----------------------------------------------------------------------
!       DATE
!-----------------------------------------------------------------------

  READ(CLDATE,'(I10)') IDATE
  IDAT = IDATE/100                     ! YYYYMMDD
  IETM = (IDATE - IDAT*100)*10000      ! hhmmss   [without leading zeros in hh]

!-----------------------------------------------------------------------
!       STN ID
!-----------------------------------------------------------------------

  CLINDIC = " '        '"
  CLINDIC(3:10)=CINDIC

!-----------------------------------------------------------------------
!       GEOGRAPHICAL POSITION       (X,Y,Z)
!-----------------------------------------------------------------------

  CLLAT = '            '
  CLLON = '            '
  ZLAT = ZLATA              ;      WRITE (CLLAT(2:11),'(F10.5)') ZLAT
  ZLON = ZLONA              ;      WRITE (CLLON(2:11),'(F10.5)') ZLON
  ZALT = RABSO              ;      IF (ZALTA.ge.0.) ZALT=ZALTA

!-----------------------------------------------------------------------
!       OBSERVED DATA
! VAR          IPAR              IVNM
!-----------------------------------------------------------------------

  ZT2M   = rval(1)       !        39
  ZRH    = rval(2)       !        58
  ZDEW2M = rval(3)       !
  ZSNOW  = rval(4)       !        92
  ZPSTAA = rval(5)       !         1
  ZPMERA = rval(6)       !         1

!-----------------------------------------------------------------------
!       ASSIGN VALUES FOR THE DIFFERENT VARIABLES IF THEY EXIST     INBP
!-----------------------------------------------------------------------

  INBP = 0            !  Count of number of variables with observed data

!-----------------------------------------------------------------------
!        ZPSTA       ZPMER         ps=5        pmsl=6          IVNM  = 1
!-----------------------------------------------------------------------

  ZPSTA=undef         ;      IF (ZPSTAA.ge.0.) ZPSTA = ZPSTAA
  ZPMER=RABSO         ;      IF (ZPMERA.ge.0.) ZPMER = ZPMERA

  IPRESCD=5
  IF ( ZPSTA < undef ) THEN
  IPRESCD=1
  ELSE IF ( ZPMER < RABSO ) THEN
  IPRESCD=0
  ENDIF
  IPRESCD=1

  ISTD = IPRESCD*100000

  IF ( ZPMER < RABSO .AND. ZALT < ZALTSY ) THEN

  INBP = INBP + 1
  IVNM(INBP) = 1
  ZPOB(INBP) = - ZPMER
  ZVAR(INBP) = 0.
  IFLG(INBP) = 2064

  ELSE IF ( ZPSTA < undef ) THEN

  INBP = INBP + 1
  IVNM(INBP) = 1
  ZPOB(INBP) = ZPSTA
  ZVAR(INBP) = ZALT * RG
  IFLG(INBP) = 2064

  ENDIF

!-----------------------------------------------------------------------
!        ZT2M                      temp=1                      IVNM = 39
!-----------------------------------------------------------------------

  IF (ZT2M.ge.0.) THEN

  INBP = INBP + 1
  IVNM(INBP) = 39
  ZPOB(INBP) = ZPSTA
  ZVAR(INBP) = ZT2M
  IFLG(INBP) = 2048

  ENDIF

!-----------------------------------------------------------------------
!        ZRH                       rh=2                        IVNM = 58
!-----------------------------------------------------------------------

  ZT  = RABSI
  ZTD = RABSI
  ZHU = RABSI

  IF (ZRH.ge.0.) THEN

  INBP = INBP + 1
  IVNM(INBP) = 58
  ZPOB(INBP) = ZPSTA
  ZVAR(INBP) = ZRH
  IFLG(INBP) = 2048

  ELSE

  IF ((ZT2M.ge.0.).AND.(ZDEW2M.ge.0.)) THEN

  ZT   = ZT2M
  ZTD  = ZDEW2M

  INBP = INBP + 1
  IVNM(INBP) = 58
  ZPOB(INBP) = ZPSTA
  ZVAR(INBP) = NINT( 100. * ( EW(ZTD) / EW(ZT) ) )
  ZHU        = ZVAR(INBP) / 100.
  IFLG(INBP) = 2048

  ENDIF

  ENDIF

!-----------------------------------------------------------------------
!        ZSNOW                     snow=4                      IVNM = 92
!-----------------------------------------------------------------------

  IF (ZSNOW.ge.0.) THEN

  INBP = INBP + 1
  IVNM(INBP) = 92
  ZPOB(INBP) = ZPSTA
  ZVAR(INBP) = ZSNOW
  IFLG(INBP) = 2048

  ENDIF

!-----------------------------------------------------------------------
!       Write out to file
!-----------------------------------------------------------------------

  IF ( INBP.GT.0 ) THEN

  INLV = INBP            ! Number of variables with data in this post
  IRLN = 12 + INLV*5     ! Total number of data in this record - including even this

  WRITE (61,*) IRLN,IOTP,IOCH,CLLAT,CLLON,CLINDIC
  WRITE (61,*) IDAT,IETM,ZALT,INLV,IRFL,ISTD
  DO ivar=1,INBP
  WRITE (61,*) IVNM(ivar),ZPOB(ivar),ZPRL(ivar),ZVAR(ivar),IFLG(ivar)
  END DO

  ENDIF

  end subroutine EXT_LAM_SYNOP
  REAL FUNCTION EW(T)
    IMPLICIT NONE
    REAL :: T 
    EW(T) = EXP( 60.22274788372                                    -  &
         &             27.60156807553*AMAX1(0.,SIGN(1.,273.16-T))        -  &
         &             ( 6822.400210096 -                                   &
         &               526.9788711908*AMAX1(0.,SIGN(1.,273.16-T)) )/T  -  &
         &             ALOG(T)*( 5.139266694451 -                           &
         &               4.576133536908*AMAX1(0.,SIGN(1.,273.16-T)) )      )
    RETURN
  END FUNCTION EW