SURFEX  V8_0
Surfex V8_0 release
 All Classes Files Functions Variables
pgd_topo_index.F90
Go to the documentation of this file.
1 !SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
2 !SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
3 !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
4 !SFX_LIC for details. version 1.
5 ! #########
6  SUBROUTINE pgd_topo_index (DGU, DTCO, UG, U, USS, I, &
7  hprogram,klu,hcti,hctifiletype,oimp_cti)
8 ! ##################################################################
9 !
10 !!**** *PGD_TOPO_INDEX* monitor for computing topographic index statistics used by TOIPMODEL
11 !!
12 !! PURPOSE
13 !! -------
14 !!
15 !! METHOD
16 !! ------
17 !!
18 !
19 !! EXTERNAL
20 !! --------
21 !!
22 !! IMPLICIT ARGUMENTS
23 !! ------------------
24 !!
25 !! REFERENCE
26 !! ---------
27 !!
28 !! AUTHOR
29 !! ------
30 !!
31 !! B. Decharme Meteo-France
32 !!
33 !! MODIFICATION
34 !! ------------
35 !!
36 !! Original 06/2009
37 !! B. Decharme 05/2013 New topographic index linear regression for Topmodel
38 !!
39 !----------------------------------------------------------------------------
40 !
41 !* 0. DECLARATION
42 ! -----------
43 !
44 !
45 USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
46 USE modd_data_cover_n, ONLY : data_cover_t
47 USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
48 USE modd_surf_atm_n, ONLY : surf_atm_t
49 USE modd_surf_atm_sso_n, ONLY : surf_atm_sso_t
50 USE modd_isba_n, ONLY : isba_t
51 !
52 USE modd_pgd_grid, ONLY : nl
53 !
54 !
55 USE modd_pgdwork, ONLY : xsumval, xsumval2, nsize, &
56  xmin_work, xmax_work, &
57  xmean_work, xstd_work, &
58  xskew_work, xsumval3
59 !
60 USE modd_surf_par, ONLY : xundef
61 !
62 !
63 USE modd_sgh_par, ONLY : xregp, xrega
64 !
65 USE modi_get_luout
66 USE modi_get_grid_coord
67 USE modi_read_surf
68 USE modi_treat_field
69 USE modi_pack_same_rank
70 USE modi_interpol_field
71 !
72 USE modi_init_io_surf_n
73 USE modi_end_io_surf_n
74 #ifdef SFX_ASC
75 USE modd_io_surf_asc, ONLY : cfilein
76 #endif
77 #ifdef SFX_FA
78 USE modd_io_surf_fa, ONLY : cfilein_fa
79 #endif
80 #ifdef SFX_LFI
81 USE modd_io_surf_lfi, ONLY : cfilein_lfi
82 #endif
83 !
84 USE yomhook ,ONLY : lhook, dr_hook
85 USE parkind1 ,ONLY : jprb
86 !
87 USE modi_abor1_sfx
88 !
89 USE modi_get_surf_mask_n
90 !
91 USE modi_get_type_dim_n
92 !
93 IMPLICIT NONE
94 !
95 !* 0.1 Declaration of arguments
96 ! ------------------------
97 !
98 !
99 TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
100 TYPE(data_cover_t), INTENT(INOUT) :: dtco
101 TYPE(surf_atm_grid_t), INTENT(INOUT) :: ug
102 TYPE(surf_atm_t), INTENT(INOUT) :: u
103 TYPE(surf_atm_sso_t), INTENT(INOUT) :: uss
104 TYPE(isba_t), INTENT(INOUT) :: i
105 !
106  CHARACTER(LEN=6), INTENT(IN) :: hprogram ! program calling
107 INTEGER, INTENT(IN) :: klu ! number of nature points
108  CHARACTER(LEN=28), INTENT(IN) :: hcti ! topographic index file name
109  CHARACTER(LEN=6), INTENT(IN) :: hctifiletype ! topographic index file type
110 LOGICAL, INTENT(IN) :: oimp_cti ! .true. if topographic index statistics is imposed
111 !
112 !
113 !* 0.2 Declaration of local variables
114 ! ------------------------------
115 !
116 REAL, DIMENSION(:), ALLOCATABLE :: zlat, zdelta, zmean_ini, &
117  zti_mean, zti_std, zti_skew
118 !
119 INTEGER, DIMENSION(:), ALLOCATABLE :: imask
120 !
121 LOGICAL :: lreg,lreg10,lreg2
122 !
123 INTEGER :: ifull ! total number of points
124 INTEGER :: i_dim
125 INTEGER :: iret ! error code
126 INTEGER :: iluout ! output listing logical unit
127 !
128  CHARACTER(LEN=6 ) :: yfiletype, yscheme, ysubroutine
129  CHARACTER(LEN=20) :: yfield ! Name of the field.
130 REAL(KIND=JPRB) :: zhook_handle
131 !
132 !-------------------------------------------------------------------------------
133 !
134 !* 1. Initializations
135 ! ---------------
136 !
137 IF (lhook) CALL dr_hook('PGD_TOPO_INDEX',0,zhook_handle)
138 IF(len_trim(hcti)==0)THEN
139 !
140  ALLOCATE(i%XTI_MIN (0))
141  ALLOCATE(i%XTI_MAX (0))
142  ALLOCATE(i%XTI_MEAN(0))
143  ALLOCATE(i%XTI_STD (0))
144  ALLOCATE(i%XTI_SKEW(0))
145 !
146 !-------------------------------------------------------------------------------
147 ELSE
148 !-------------------------------------------------------------------------------
149 !
150  i%LCTI = .true.
151 !
152 !* 2. Find LUOUT
153 ! ----------
154 !
155  CALL get_luout(hprogram,iluout)
156 !
157  WRITE(iluout,*) '*****************************************'
158  WRITE(iluout,*) 'Comput Topographic indexes for TOPMODEL '
159  WRITE(iluout,*) '*****************************************'
160 !
161 !* 3. Allocations of statistics arrays
162 ! --------------------------------
163 !
164  ALLOCATE(i%XTI_MIN (klu))
165  ALLOCATE(i%XTI_MAX (klu))
166  ALLOCATE(i%XTI_MEAN(klu))
167  ALLOCATE(i%XTI_STD (klu))
168  ALLOCATE(i%XTI_SKEW(klu))
169 !
170  i%XTI_MIN (:) = xundef
171  i%XTI_MAX (:) = xundef
172  i%XTI_MEAN(:) = xundef
173  i%XTI_STD (:) = xundef
174  i%XTI_SKEW(:) = xundef
175 !
176 !-------------------------------------------------------------------------------
177 !
178 !* 4. Allocations of work arrays
179 ! --------------------------
180 !
181  CALL get_type_dim_n(dtco, u, &
182  'NATURE',i_dim)
183  IF (i_dim/=klu) THEN
184  WRITE(iluout,*)'PGD_TOPO_INDEX: Wrong dimension of MASK: ',i_dim,klu
185  CALL abor1_sfx('PGD_TOPO_INDEX: WRONG DIMENSION OF MASK')
186  ENDIF
187 !
188  ALLOCATE(imask(klu))
189  ifull=0
190  CALL get_surf_mask_n(dtco, u, &
191  'NATURE',klu,imask,ifull,iluout)
192  IF (ifull/=nl) THEN
193  WRITE(iluout,*)'PGD_TOPO_INDEX: Wrong dimension of FULL: ',ifull,nl
194  CALL abor1_sfx('PGD_TOPO_INDEX: WRONG DIMENSION OF FULL')
195  ENDIF
196 !
197  ALLOCATE(xmin_work(ifull))
198  ALLOCATE(xmax_work(ifull))
199  ALLOCATE(xmean_work(ifull))
200  ALLOCATE(xstd_work(ifull))
201  ALLOCATE(xskew_work(ifull))
202 !
203  xmin_work(:)=xundef
204  xmax_work(:)=xundef
205  xmean_work(:)=xundef
206  xstd_work(:)=xundef
207  xskew_work(:)=xundef
208 !
209 !-------------------------------------------------------------------------------
210 !
211 !* 5. Use of imposed field
212 ! --------------------
213 !
214  IF (oimp_cti) THEN
215 !
216  yfiletype=hctifiletype
217  IF(hctifiletype=='NETCDF')THEN
218  CALL abor1_sfx('Use another format than netcdf for cti input file with LIMP_CTI')
219  ELSE
220 #ifdef SFX_ASC
221  cfilein = adjustl(adjustr(hcti)//'.txt')
222 #endif
223 #ifdef SFX_FA
224  cfilein_fa = adjustl(adjustr(hcti)//'.fa')
225 #endif
226 #ifdef SFX_LFI
227  cfilein_lfi = adjustl(hcti)
228 #endif
229  CALL init_io_surf_n(dtco, dgu, u, &
230  yfiletype,'FULL ','SURF ','READ ')
231  ENDIF
232 !
233  CALL read_surf(&
234  yfiletype,'TI_MIN' ,xmin_work ,iret)
235  CALL read_surf(&
236  yfiletype,'TI_MAX' ,xmax_work ,iret)
237  CALL read_surf(&
238  yfiletype,'TI_MEAN',xmean_work,iret)
239  CALL read_surf(&
240  yfiletype,'TI_STD' ,xstd_work ,iret)
241  CALL read_surf(&
242  yfiletype,'TI_SKEW',xskew_work,iret)
243 !
244  CALL end_io_surf_n(yfiletype)
245 !
246  ELSE
247 !
248 !-------------------------------------------------------------------------------
249 !
250 !* 6. Use of cti file
251 ! ---------------
252 !
253  ALLOCATE(nsize(ifull))
254  ALLOCATE(xsumval(ifull))
255  ALLOCATE(xsumval2(ifull))
256  ALLOCATE(xsumval3(ifull))
257 !
258  nsize(:) = 0.
259  xsumval(:) = 0.
260  xsumval2(:) = 0.
261  xsumval3(:) = 0.
262 !
263  xmax_work(:) =-99999.
264 !
265  yfield = 'CTI'
266  yscheme = 'SURF '
267  ysubroutine = 'A_CTI '
268  CALL treat_field(ug, u, uss, &
269  hprogram,yscheme,hctifiletype,ysubroutine,hcti,yfield)
270 !
271 !-------------------------------------------------------------------------------
272 !
273 !* 7. Coherence
274 ! ---------
275 !
276  WHERE(nsize(:)<36.OR.xstd_work(:)==0.0)
277  xmin_work(:) = xundef
278  xmax_work(:) = xundef
279  xmean_work(:) = xundef
280  xstd_work(:) = xundef
281  xskew_work(:) = xundef
282  nsize(:) = 0
283  ENDWHERE
284 !
285  WHERE(u%XNATURE(:)>0.0.AND.xskew_work(:)<=-8.0)
286  xmin_work(:) = xundef
287  xmax_work(:) = xundef
288  xmean_work(:) = xundef
289  xstd_work(:) = xundef
290  xskew_work(:) = xundef
291  nsize(:) = 0
292  ENDWHERE
293 !
294  WHERE(u%XNATURE(:)==0.)
295  xmin_work(:) = xundef
296  xmax_work(:) = xundef
297  xmean_work(:) = xundef
298  xstd_work(:) = xundef
299  xskew_work(:) = xundef
300  nsize(:) = 0
301  ENDWHERE
302 !
303 !-------------------------------------------------------------------------------
304 !
305 !* 8. Regression 1km to 100m or 2m
306 ! ----------------------------
307 !
308  IF(hctifiletype=='DIRECT')THEN
309 !
310 ! Topographic index linear regression for Topmodel if topo ref at 1km
311 ! pan and king (2012) 1km to 2m
312 !
313  CALL ctireg(lreg,lreg10,lreg2)
314 !
315  IF(all(xmean_work(:)==xundef))lreg=.false.
316 !
317  IF(lreg)THEN
318 !
319  WRITE(iluout,*)'WITH DIF, TOPO INDEX USED REGRESSIONS OF '
320 !
321  ALLOCATE(zdelta(ifull))
322  ALLOCATE(zmean_ini(ifull))
323  ALLOCATE(zti_mean(ifull))
324  ALLOCATE(zti_std(ifull))
325  ALLOCATE(zti_skew(ifull))
326 !
327  zmean_ini(:)=xmean_work(:)
328  zti_mean(:)=xundef
329  zti_std(:)=xundef
330  zti_skew(:)=xundef
331  zdelta(:)= 0.0
332 !
333 ! 1km to 10m
334  IF(lreg10)THEN
335  WRITE(iluout,*)' PAN AND KING (2012) 1km to 10m '
336  WHERE(xmean_work(:)/=xundef.AND.(xmax_work(:)-xmin_work(:))>0.2)
337  zti_mean(:)= 1.136+0.657*xmean_work(:)-0.640*xstd_work(:)+0.053*xskew_work(:)
338  zti_std(:)=-0.128+0.187*xmean_work(:)+0.168*xstd_work(:)-0.261*xskew_work(:)
339  zti_skew(:)= 3.768-0.246*xmean_work(:)+0.317*xstd_work(:)+0.222*xskew_work(:)
340  ENDWHERE
341  xmean_work(:)=zti_mean(:)
342  xstd_work(:)=zti_std(:)
343  xskew_work(:)=zti_skew(:)
344  ELSE
345  zti_mean(:)=xmean_work(:)
346  zti_std(:)=xstd_work(:)
347  zti_skew(:)=xskew_work(:)
348  ENDIF
349 !
350 ! 10m to 2m
351  IF(lreg2)THEN
352  WRITE(iluout,*)' PAN AND KING (2012) 10m to 2m '
353  WHERE(xmean_work(:)/=xundef.AND.(xmax_work(:)-xmin_work(:))>0.2)
354  xmean_work(:)=-3.826+1.402*zti_mean(:)-0.434*zti_std(:)+0.328*zti_skew(:)
355  xstd_work(:)= 3.655-0.209*zti_mean(:)+0.440*zti_std(:)-0.091*zti_skew(:)
356  xskew_work(:)= 2.266-0.023*zti_mean(:)-0.245*zti_std(:)-0.240*zti_skew(:)
357  ENDWHERE
358  ENDIF
359 !
360  WHERE(xmean_work(:)>0.0.AND.xmean_work(:)/=xundef)
361  zdelta(:)= (xmean_work(:)-zmean_ini(:))
362  xmin_work(:)= max( 0.0,xmin_work(:)+zdelta(:))
363  xmax_work(:)= max(xmin_work(:)+0.2,xmax_work(:)+zdelta(:))
364  ELSEWHERE
365  xmin_work(:) = xundef
366  xmax_work(:) = xundef
367  xmean_work(:) = xundef
368  xstd_work(:) = xundef
369  xskew_work(:) = xundef
370  nsize(:) = 0
371  ENDWHERE
372 !
373  DEALLOCATE(zdelta )
374  DEALLOCATE(zmean_ini)
375  DEALLOCATE(zti_mean )
376  DEALLOCATE(zti_std )
377  DEALLOCATE(zti_skew )
378 !
379  ENDIF
380 !
381  ENDIF
382 !
383 !-------------------------------------------------------------------------------
384 !
385 !* 10. Interpolation if some points are not initialized (no data for these points)
386 ! ------------------------------------------------
387 !
388  WRITE(iluout,*) '*********************************************'
389  WRITE(iluout,*) 'Interpolation if some index not initialized '
390  WRITE(iluout,*) '*********************************************'
391 !
392  ALLOCATE(zlat(nl))
393  CALL get_grid_coord(ug, u, &
394  iluout,py=zlat)
395 !
396  WHERE (u%XNATURE(:)==0..AND.nsize(:)==0) nsize(:) = -1
397 !
398 ! No Antarctic
399  WHERE(u%XNATURE(:)>0..AND.zlat(:)<-60.)
400  xmin_work(:) = xundef
401  xmax_work(:) = xundef
402  xmean_work(:) = xundef
403  xstd_work(:) = xundef
404  xskew_work(:) = xundef
405  nsize(:) = -1
406  ENDWHERE
407 !
408  IF(all(nsize(:)==0.0))nsize(:)=-1
409 !
410  CALL interpol_field(ug, u, &
411  hprogram,iluout,nsize,xmin_work(:),'TI_MIN ',pdef=xundef,knpts=1)
412  CALL interpol_field(ug, u, &
413  hprogram,iluout,nsize,xmax_work(:),'TI_MAX ',pdef=xundef,knpts=1)
414  CALL interpol_field(ug, u, &
415  hprogram,iluout,nsize,xmean_work(:),'TI_MEAN',pdef=xundef,knpts=1)
416  CALL interpol_field(ug, u, &
417  hprogram,iluout,nsize,xstd_work(:),'TI_STD ',pdef=xundef,knpts=1)
418  CALL interpol_field(ug, u, &
419  hprogram,iluout,nsize,xskew_work(:),'TI_SKEW',pdef=xundef,knpts=1)
420 !
421  DEALLOCATE(nsize )
422  DEALLOCATE(xsumval )
423  DEALLOCATE(xsumval2 )
424  DEALLOCATE(xsumval3 )
425  DEALLOCATE(zlat )
426 !
427  ENDIF
428 !-------------------------------------------------------------------------------
429 !
430 !* 11. Asign parameters
431 ! ----------------
432 !
433  CALL pack_same_rank(imask,xmin_work ,i%XTI_MIN)
434  CALL pack_same_rank(imask,xmax_work ,i%XTI_MAX)
435  CALL pack_same_rank(imask,xmean_work,i%XTI_MEAN)
436  CALL pack_same_rank(imask,xstd_work ,i%XTI_STD)
437  CALL pack_same_rank(imask,xskew_work,i%XTI_SKEW)
438 !
439 !-------------------------------------------------------------------------------
440 !
441  DEALLOCATE(xmin_work )
442  DEALLOCATE(xmax_work )
443  DEALLOCATE(xmean_work)
444  DEALLOCATE(xstd_work )
445  DEALLOCATE(xskew_work)
446 !
447  WRITE(iluout,*) '******************************'
448  WRITE(iluout,*) 'End Comput Topographic indexes'
449  WRITE(iluout,*) '******************************'
450 !
451 ENDIF
452 !
453 IF (lhook) CALL dr_hook('PGD_TOPO_INDEX',1,zhook_handle)
454 !-------------------------------------------------------------------------------
455 !
456  CONTAINS
457 !
458 SUBROUTINE ctireg(OREG,OREG10,OREG2)
459 !
460 !* 0. DECLARATION
461 ! -----------
462 !
463 USE modi_open_namelist
464 USE modi_close_namelist
465 !
466 USE yomhook ,ONLY : lhook, dr_hook
467 USE parkind1 ,ONLY : jprb
468 !
469 IMPLICIT NONE
470 !
471 !* 0.1 Declaration of arguments
472 ! ------------------------
473 !
474 LOGICAL, INTENT(OUT) :: oreg,oreg10,oreg2 ! regression key
475 !
476 !* 0.2 Declaration of local variables
477 ! ------------------------------
478 !
479 REAL :: zdlat ! latitude mesh in the data file
480 REAL :: zdlon ! longitude mesh in the data file
481 REAL :: zglblatmin ! minimum latitude of data box in the file
482 REAL :: zglblonmin ! minimum longitude of data box in the file
483 REAL :: zglblatmax ! maximum latitude of data box in the file
484 REAL :: zglblonmax ! maximum longitude of data box in the file
485 !
486  CHARACTER(LEN=28) :: yfilehdr ! Name of the field file header
487 !
488 INTEGER :: inblat
489 INTEGER :: inblon
490 INTEGER :: iglb
491 INTEGER :: jhead ! loop control
492 INTEGER :: inindex ! index of character 'N' in YSTRING1
493 INTEGER :: isindex ! index of character 'S' in YSTRING1
494 INTEGER :: ieindex ! index of character 'E' in YSTRING1
495 INTEGER :: iwindex ! index of character 'W' in YSTRING1
496 REAL, DIMENSION(7) :: zval ! values of the head data
497 INTEGER :: ihead ! index of the data in the array ZVAL
498  CHARACTER(LEN=100) :: ystring ! total string in the head
499  CHARACTER(LEN=100) :: ystring1 ! string less the begining line descriptor
500  CHARACTER(LEN=100) :: yval ! absolute value of the data of the line
501 INTEGER :: ipoint ! index of '.' in the string YVAL
502 INTEGER :: ilength ! length of the string YVAL
503 INTEGER :: ifraclength! length of the fractional part in string YVAL
504  CHARACTER(LEN=2) :: ylength ! length of the string YVAL
505  CHARACTER(LEN=2) :: yfraclength! length of the fractional part in string YVAL
506  CHARACTER(LEN=10) :: yinternalformat ! format to read YVAL in real ZVAL
507 !
508 REAL :: z1000m, z100m, z10m
509 !
510 REAL(KIND=JPRB) :: zhook_handle
511 !
512 !-------------------------------------------------------------------------------
513 !
514 IF (lhook) CALL dr_hook('PGD_TOPO_INDEX:CTIREG',0,zhook_handle)
515 !
516 oreg =.false.
517 oreg10=.false.
518 oreg2 =.false.
519 !
520 iglb=11
521 yfilehdr =adjustl(adjustr(hcti)//'.hdr')
522  CALL open_namelist(hprogram,iglb,yfilehdr)
523 !
524 !* 1. Line of comments
525 ! ----------------
526 !
527 READ (iglb,'(A100)',end=99) ystring
528 !
529 !-------------------------------------------------------------------------------
530 !
531 !* 2. Other lines
532 ! -----------
533 !
534 DO jhead=1,7
535  READ (iglb,'(A100)',end=99) ystring
536  ystring=adjustl(ystring)
537 !
538 !* 2.1 Selection of the line
539 ! ---------------------
540 !
541  SELECT CASE (ystring(1:5))
542  CASE('cutva')
543  ihead=1
544  ystring1=ystring(10:100)
545  CASE('nodat')
546  ihead=1
547  ystring1=ystring(8:100)
548  CASE('north')
549  ihead=2
550  ystring1=ystring(7:100)
551  CASE('south')
552  ihead=3
553  ystring1=ystring(7:100)
554  CASE('east:')
555  ihead=4
556  ystring1=ystring(6:100)
557  CASE('west:')
558  ihead=5
559  ystring1=ystring(6:100)
560  CASE('rows:')
561  ihead=6
562  ystring1=ystring(6:100)
563  CASE('cols:')
564  ihead=7
565  ystring1=ystring(6:100)
566  END SELECT
567 !
568 !* 2.2 Test on presence of geographical descritor (N, E, S or W)
569 ! ---------------------------------------------------------
570 !
571  inindex=index(ystring1,'N')
572  isindex=index(ystring1,'S')
573  ieindex=index(ystring1,'E')
574  iwindex=index(ystring1,'W')
575  yval=adjustl(ystring1)
576  IF (inindex/=0) yval=adjustl(ystring1(1:inindex-1))
577  IF (isindex/=0) yval='-'//adjustl(ystring1(1:isindex-1))
578  IF (ieindex/=0) yval=adjustl(ystring1(1:ieindex-1))
579  IF (iwindex/=0) yval='-'//adjustl(ystring1(1:iwindex-1))
580 !
581 !* 2.3 Transformation of the data in real
582 ! ----------------------------------
583 !
584  ipoint=index(yval,'.')
585  IF (ipoint==0) yval=adjustl(adjustr(yval)//'.')
586 !
587 !* 2.4 Definition of the format of the data
588 ! ------------------------------------
589 !
590  ilength=len_trim(adjustl(adjustr(yval)))
591  ifraclength=ilength-index(yval,'.')
592  WRITE(ylength,'(I2)') ilength
593  WRITE(yfraclength,'(I2)') ifraclength
594  yinternalformat='(F'//ylength//'.'//yfraclength//')'
595 !
596 !* 2.5 Data definition
597 ! ---------------
598 !
599  READ(yval,adjustl(yinternalformat)) zval(ihead)
600 !
601 ENDDO
602 !
603 !-------------------------------------------------------------------------------
604 !
605 !* 3. Initialization of arguments, longitudes and latitudes
606 ! -----------------------------------------------------
607 !
608 zglblatmax=zval(2)
609 zglblatmin=zval(3)
610 zglblonmin=zval(5)
611 zglblonmax=zval(4)+nint((zval(5)-zval(4)+180.+1.e-10)/360.)*360.
612 inblat=nint(zval(6))
613 inblon=nint(zval(7))
614 !
615 zdlat=(zglblatmax-zglblatmin)/inblat
616 zdlon=(zglblonmax-zglblonmin)/inblon
617 !
618 z1000m = 30./3600. !(minute arc to m)
619 z100m = z1000m/10.
620 z10m = z1000m/100.
621 !
622 IF(sqrt(zdlat*zdlon)>z100m)THEN
623  oreg =.true.
624  oreg10=.true.
625  oreg2 =.true.
626 ENDIF
627 !
628 IF(sqrt(zdlat*zdlon)>=z10m.AND.sqrt(zdlat*zdlon)<=z100m)THEN
629  oreg =.true.
630  oreg10=.false.
631  oreg2 =.true.
632 ENDIF
633 !
634  CALL close_namelist(hprogram,iglb)
635 !
636 IF (lhook) CALL dr_hook('PGD_TOPO_INDEX:CTIREG',1,zhook_handle)
637 RETURN
638 99 CONTINUE
639  CALL abor1_sfx('CTIREG: PB READING TOPO INDEX FILE HEADER')
640 IF (lhook) CALL dr_hook('PGD_TOPO_INDEX:CTIREG',1,zhook_handle)
641 !
642 END SUBROUTINE ctireg
643 !
644 !-------------------------------------------------------------------------------
645 END SUBROUTINE pgd_topo_index
get_type_dim_n
subroutine get_type_dim_n(DTCO, U, HTYPE, KDIM)
Definition: get_type_dimn.F90:6
init_io_surf_n
subroutine init_io_surf_n(DTCO, DGU, U, HPROGRAM, HMASK, HSCHEME, HACTION)
Definition: init_io_surfn.F90:6
modd_surf_atm_sso_n::surf_atm_sso_t
Definition: modd_surf_atm_sson.F90:40
modd_surf_atm_n::surf_atm_t
Definition: modd_surf_atmn.F90:42
modd_isba_n
Definition: modd_isban.F90:6
modi_read_surf
Definition: read_surf.F90:6
modd_surf_atm_grid_n
Definition: modd_surf_atm_gridn.F90:6
modd_pgdwork
Definition: modd_pgdwork.F90:6
pgd_topo_index
subroutine pgd_topo_index(DGU, DTCO, UG, U, USS, I, HPROGRAM, KLU, HCTI, HCTIFILETYPE, OIMP_CTI)
Definition: pgd_topo_index.F90:6
modd_data_cover_n
Definition: modd_data_covern.F90:6
ctireg
subroutine ctireg(OREG, OREG10, OREG2)
Definition: pgd_topo_index.F90:458
get_grid_coord
subroutine get_grid_coord(UG, U, KLUOUT, PX, PY, KL, HGRID, PGRID_PAR)
Definition: get_grid_coord.F90:6
modi_read_surf::read_surf
Definition: read_surf.F90:44
modd_diag_surf_atm_n
Definition: modd_diag_surf_atmn.F90:6
modd_surf_atm_grid_n::surf_atm_grid_t
Definition: modd_surf_atm_gridn.F90:39
treat_field
subroutine treat_field(UG, U, USS, HPROGRAM, HSCHEME, HFILETYPE, HSUBROUTINE, HFILENAME, HFIELD, PPGDARRAY, HSFTYPE)
Definition: treat_field.F90:6
modd_io_surf_fa
Definition: modd_io_surf_fa.F90:6
abor1_sfx
subroutine abor1_sfx(YTEXT)
Definition: abor1_sfx.F90:6
get_surf_mask_n
subroutine get_surf_mask_n(DTCO, U, HTYPE, KDIM, KMASK, KLU, KLUOUT)
Definition: get_surf_maskn.F90:6
modi_pack_same_rank
Definition: pack_same_rank.F90:6
modd_sgh_par
Definition: modd_sgh_par.F90:6
close_namelist
subroutine close_namelist(HPROGRAM, KLUNAM)
Definition: close_namelist.F90:6
modd_io_surf_asc
Definition: modd_io_surf_asc.F90:6
end_io_surf_n
subroutine end_io_surf_n(HPROGRAM)
Definition: end_io_surfn.F90:6
get_luout
subroutine get_luout(HPROGRAM, KLUOUT)
Definition: get_luout.F90:6
interpol_field
subroutine interpol_field(UG, U, HPROGRAM, KLUOUT, KCODE, PFIELD, HFIELD, PDEF, KNPTS)
Definition: interpol_field.F90:6
modi_pack_same_rank::pack_same_rank
Definition: pack_same_rank.F90:8
modd_surf_atm_sso_n
Definition: modd_surf_atm_sson.F90:6
modd_data_cover_n::data_cover_t
Definition: modd_data_covern.F90:43
modd_surf_par
Definition: modd_surf_par.F90:6
modd_io_surf_lfi
Definition: modd_io_surf_lfi.F90:6
open_namelist
subroutine open_namelist(HPROGRAM, KLUNAM, HFILE)
Definition: open_namelist.F90:6
modd_diag_surf_atm_n::diag_surf_atm_t
Definition: modd_diag_surf_atmn.F90:44
modd_pgd_grid
Definition: modd_pgd_grid.F90:6
modd_surf_atm_n
Definition: modd_surf_atmn.F90:6
Generated on Fri May 13 2016 09:31:05 for SURFEX by   doxygen 1.8.5