SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/OFFLIN/sxpost.F90 Source File

Go to the documentation of this file.
00001 !     ######spl
00002         PROGRAM SXPOST
00003 !
00004 !!    MODIFICATIONS
00005 !!    -------------
00006 !!      B. Decharme : partition pgd/prep (grid attributes are only in the PGD file)
00007 !!
00008 !-------------------------------------------------------------------------------
00009 !        
00010         USE MODD_IO_SURF_ASC
00011         USE MODD_SURF_PAR
00012         USE MODI_READ_SURF
00013         USE MODI_GET_LUOUT
00014         USE MODE_POS_SURF
00015         USE MODD_IO_SURF_OL, ONLY : XSTART,XCOUNT,XSTRIDE,LPARTR
00016         
00017 !
00018         USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00019         USE PARKIND1  ,ONLY : JPRB
00020 !
00021         USE MODI_ABOR1_SFX
00022 !
00023         USE MODI_GOTO_SURFEX
00024         USE MODI_GET_LUOUT
00025 !
00026         USE MODI_ALLOC_SURFEX
00027         USE MODI_DEALLOC_SURFEX
00028         USE MODI_END_IO_SURF_n
00029         USE MODI_INIT_IO_SURF_n
00030         IMPLICIT NONE        
00031 
00032         REAL, ALLOCATABLE, DIMENSION(:)   ::   ZLOC
00033         REAL, ALLOCATABLE, DIMENSION(:)   ::   ZWRK
00034         REAL, ALLOCATABLE, DIMENSION(:)   ::   XLON
00035         REAL, ALLOCATABLE, DIMENSION(:)   ::   XLAT
00036         INTEGER, ALLOCATABLE, DIMENSION(:)::   IWRK2
00037         CHARACTER(LEN=50)                 ::   YCOMMENT
00038         CHARACTER(LEN=50)                 ::   NOM_ARTICLE
00039         CHARACTER(LEN=12)                 ::   HREC
00040         CHARACTER(LEN=1)                  ::   PATCHFLAG
00041         CHARACTER(LEN=2)                  ::   YPAS,YLVL
00042         CHARACTER(LEN=10)                 ::   CGRID_TYPE
00043         CHARACTER(LEN=6)                  ::   CMASK_SAVE
00044         LOGICAL                           ::   GFOUND
00045         LOGICAL                           ::   LINITS ! true if PGD has been run
00046         LOGICAL                           ::   LINITP ! true if PREP has been run
00047         LOGICAL                           ::   LSXNAM ! true if SXPOST.nam present
00048         LOGICAL                           ::   LCOORD ! true if LONLAT.dat present
00049         LOGICAL                           ::   LGEO=.TRUE.  !
00050 
00051         CHARACTER(LEN=28)  :: YLUOUT ='LISTING_SXPOST                '  ! name of listing
00052 
00053         INTEGER    ::   IRET
00054         INTEGER    ::   INI, INI_N
00055         INTEGER    ::   INJ
00056         INTEGER    ::   IF, IC, IP
00057         INTEGER    ::   IFIELD, IWFIELD
00058         INTEGER    ::   IPATCH, JPATCH
00059         INTEGER    ::   IBEG, IEND
00060         REAL(KIND=JPRB) :: ZHOOK_HANDLE
00061 
00062         
00063         !=====================================================================
00064         !*
00065         !** check if file exists
00066         !*
00067         !=====================================================================
00068         IF (LHOOK) CALL DR_HOOK('SXPOST',0,ZHOOK_HANDLE)
00069         CALL ALLOC_SURFEX(1)
00070 
00071         CALL GET_LUOUT('ASCII ',NLUOUT)
00072         OPEN(UNIT=NLUOUT,FILE=ADJUSTL(ADJUSTR(YLUOUT)//'.txt'),&
00073                         FORM='FORMATTED',ACTION='WRITE')
00074 
00075         INQUIRE(FILE='SXPOST.nam', EXIST=LSXNAM)
00076         IF (.NOT.LSXNAM) THEN
00077            WRITE(*,*)' > SXPOST.nam missing'
00078            CALL ABOR1_SFX('SXPOST: NAMELIST SXPOST.nam MISSING')
00079         ENDIF
00080 
00081         INQUIRE(FILE='PGD.txt',    EXIST=LINITS)
00082         INQUIRE(FILE='PREP.txt',   EXIST=LINITP)
00083 
00084         IF (.NOT. LINITP .AND. .NOT. LINITS) THEN
00085            WRITE(*,*)' NO INPUT FILE FOUND FOR SXPOST'
00086            WRITE(*,*)' YOU SHOULD AT LEAST RUN PGD! '
00087            CALL ABOR1_SFX('SXPOST: NO INPUT FILE')
00088         ENDIF
00089 
00090         CFILEIN = 'PGD.txt'
00091 
00092         !=====================================================================
00093         !*
00094         !** get number of patches
00095         !*
00096         !=====================================================================
00097 
00098         CALL GOTO_SURFEX(1,.TRUE.)
00099 
00100         CALL INIT_IO_SURF_n('ASCII ','FULL  ','SURF  ','READ ')
00101 
00102         CALL READ_SURF('ASCII ','DIM_FULL', INI, IRET)
00103         CALL READ_SURF('ASCII ','GRID_TYPE', CGRID_TYPE, IRET)
00104         CALL READ_SURF('ASCII ','DIM_NATURE', INI_N, IRET)        
00105            
00106         CALL END_IO_SURF_n('ASCII ')
00107 
00108         NFULL = INI
00109 
00110         IF (INI_N.NE.0) THEN
00111           CALL INIT_IO_SURF_n('ASCII ','NATURE','SURF  ','READ ')
00112 
00113           CALL READ_SURF('ASCII ','PATCH_NUMBER', IPATCH, IRET)
00114 
00115           CALL END_IO_SURF_n('ASCII ')
00116         ENDIF
00117 
00118         !=====================================================================
00119         !*
00120         !** get domain size and read latitudes and longitudes 
00121         !*
00122         !=====================================================================
00123         CALL INIT_IO_SURF_n('ASCII ','FULL  ','SURF  ','READ ')
00124 
00125         OPEN(UNIT=45,FILE='SXPOST.nam',FORM='FORMATTED')
00126         READ(45,*)IFIELD
00127 
00128         INQUIRE(FILE='LONLAT.dat',EXIST=LCOORD)
00129         ALLOCATE(XLON(INI))
00130         ALLOCATE(XLAT(INI))
00131         OPEN(UNIT=30,FILE='LONLAT.dat',FORM='FORMATTED')
00132 
00133         IF (LCOORD) THEN
00134           DO IP=1,INI
00135             READ(30,*)XLON(IP),XLAT(IP)
00136           ENDDO
00137         ELSE
00138           WRITE(*,*) 'LONLAT.DAT file missing !'
00139           IF (CGRID_TYPE=='GAUSS     ') THEN
00140             CALL POSNAM(NUNIT,'FULL  '//' '//'LONGAUSS',GFOUND,NLUOUT)
00141           ELSE
00142             CALL POSNAM(NUNIT,'FULL  '//' '//'XLON',GFOUND,NLUOUT)
00143           ENDIF
00144 
00145          IF (.NOT.GFOUND) THEN
00146            CALL ERR_STOP('XLON            ',CFILEIN,NLUOUT)
00147          ELSE
00148            READ(NUNIT,FMT=*)
00149            READ(NUNIT,FMT='(A50)') YCOMMENT
00150            READ(NUNIT,FMT=*,ERR=100) XLON(:)
00151 
00152            IF (CGRID_TYPE=='GAUSS     ') THEN
00153              CALL POSNAM(NUNIT,'FULL  '//' '//'LATGAUSS',GFOUND,NLUOUT)
00154            ELSE
00155              CALL POSNAM(NUNIT,'FULL  '//' '//'XLAT',GFOUND,NLUOUT)
00156            ENDIF
00157 
00158            READ(NUNIT,FMT=*)
00159            READ(NUNIT,FMT='(A50)') YCOMMENT
00160            READ(NUNIT,FMT=*,ERR=100) XLAT(:)
00161 
00162            DO IP=1,INI
00163              WRITE(30,*)XLON(IP),XLAT(IP)
00164            ENDDO
00165          ENDIF
00166        ENDIF
00167 
00168        CALL END_IO_SURF_n('ASCII ')
00169 
00170        IF (IFIELD==0) STOP
00171 
00172        !=====================================================================
00173        !*
00174        !** read 2d fields from PGD.txt or PREP.txt if exists
00175        !*
00176        !=====================================================================
00177 
00178        ! Search var first in PREP file
00179        IC=0
00180 
00181        DO IF=1,IFIELD
00182 
00183          READ(45,'(A1,1X,A6,1X,A16)') PATCHFLAG,CMASK,HREC
00184          CMASK_SAVE = CMASK
00185 
00186          IF (PATCHFLAG == '+') THEN
00187            INJ = INI * IPATCH
00188          ELSE IF (PATCHFLAG == '-') THEN
00189            INJ = INI
00190          ELSE
00191            PRINT*,' '
00192            PRINT*,' WRONG PATCHFLAG IN SXPOST.nam '
00193            PRINT*,' USE + FOR PATCHED VARIABLES '
00194            PRINT*,' USE - FOR UNPATCHED VARIABLES '
00195            PRINT*,' '
00196            PRINT*,' SYNTAX OF SXPOST.nam SHOULD LOOK: '
00197            PRINT*,' '
00198            PRINT*,'2 '
00199            PRINT*,'- FULL   ZS  '
00200            PRINT*,'+ NATURE TG1 '
00201            PRINT*,' '
00202            CALL ABOR1_SFX('SXPOST: WRONG PATCHFLAG')
00203          ENDIF
00204 
00205          ALLOCATE(ZWRK(INJ))
00206          IC=IC+1
00207          
00208          IF (LINITP) CFILEIN = 'PREP.txt'
00209          CALL INIT_IO_SURF_n('ASCII ',CMASK_SAVE,'SURF  ','READ ')
00210          CALL POSNAM(NUNIT,CMASK//' '//HREC,GFOUND,NLUOUT)
00211          IF (.NOT.GFOUND .AND. LINITP)THEN
00212            ! Search now in PGD file
00213            CALL END_IO_SURF_n('ASCII ')
00214            CFILEIN = 'PGD.txt'
00215            CALL INIT_IO_SURF_n('ASCII ',CMASK,'SURF  ','READ ')
00216            CALL POSNAM(NUNIT,CMASK//' '//HREC,GFOUND,NLUOUT)
00217          ENDIF
00218          IF (.NOT.GFOUND) CALL ERR_STOP(HREC,CFILEIN,NLUOUT)
00219 
00220          READ(NUNIT,FMT='(A50)') NOM_ARTICLE
00221          READ(NUNIT,FMT='(A50)') YCOMMENT
00222          READ(NUNIT,FMT=*,ERR=100) ZWRK
00223          ALLOCATE(ZLOC(INJ))
00224          ZLOC(:)=ZWRK(:)
00225          WHERE(ZLOC(:)==999.) ZLOC(:)=-999.
00226 
00227          PRINT*,CMASK,' ',HREC,' ','MINVAL = ',MINVAL(ZWRK(:)),&
00228                      ' MAXVAL = ',MAXVAL(ZLOC(:))
00229          DEALLOCATE(ZLOC)
00230 
00231          IWFIELD=1
00232          IF (PATCHFLAG == '+') THEN
00233            DO JPATCH=1,IPATCH
00234              WRITE(YPAS,'(I2)') JPATCH
00235              YLVL=ADJUSTL(YPAS(:LEN_TRIM(YPAS)))
00236              OPEN(UNIT=30,FILE=TRIM(HREC)//'_p'//TRIM(YLVL)//'.dat',FORM='FORMATTED')
00237              IBEG=INI*(JPATCH-1)+1
00238              IEND=INI*JPATCH
00239              IF (LGEO) THEN
00240                DO IP=1,INI
00241                  !IF (ZWRK(IP)/=XUNDEF) THEN
00242                  WRITE(30,*)XLON(IP),XLAT(IP),ZWRK(INI*(JPATCH-1)+IP)
00243                  !ENDIF
00244                ENDDO
00245              ELSE
00246                WRITE(30,*)NOM_ARTICLE
00247                WRITE(30,*)YCOMMENT
00248                DO IP=1,INI
00249                  WRITE(30,*)ZWRK(IP)
00250                ENDDO
00251                !WRITE(30,*)INI
00252                !WRITE(30,'(60F16.8)')ZWRK(IBEG:IEND)
00253              ENDIF
00254              CLOSE(30)
00255            ENDDO
00256          ELSE
00257            OPEN(UNIT=30,FILE=TRIM(HREC)//'.dat',FORM='FORMATTED')
00258            IF (LGEO) THEN
00259              DO IP=1,INI
00260                !IF (ZWRK(IP)/=XUNDEF) THEN
00261                WRITE(30,*)XLAT(IP),XLON(IP),ZWRK(IP)
00262                !ENDIF
00263              ENDDO
00264            ELSE
00265              WRITE(30,*)NOM_ARTICLE
00266              WRITE(30,*)YCOMMENT
00267              DO IP=1,INI
00268                WRITE(30,*)ZWRK(IP)
00269              ENDDO
00270              !WRITE(30,*)INI
00271              !WRITE(30,'(60F16.8)')ZWRK(:)
00272            ENDIF
00273            CLOSE(30)
00274          ENDIF
00275 
00276          DEALLOCATE(ZWRK)
00277          CALL END_IO_SURF_n('ASCII ')
00278 
00279        ENDDO
00280 
00281        CLOSE(NLUOUT)
00282        CALL DEALLOC_SURFEX
00283        IF (LHOOK) CALL DR_HOOK('SXPOST',1,ZHOOK_HANDLE)
00284 
00285 
00286        STOP
00287  100   CONTINUE
00288        WRITE(NLUOUT,*) ' '
00289        WRITE(NLUOUT,*) ' ERROR WHEN READING ARTICLE',HREC
00290        WRITE(NLUOUT,*) ' '
00291        CLOSE(NLUOUT)
00292        CALL DEALLOC_SURFEX
00293        IF (LHOOK) CALL DR_HOOK('SXPOST',1,ZHOOK_HANDLE)
00294 
00295        CONTAINS
00296 
00297        SUBROUTINE ERR_STOP(HREC,CFILEIN,NLUOUT)
00298        CHARACTER(LEN=12)   ::   HREC
00299        CHARACTER(LEN=*)    ::   CFILEIN
00300        INTEGER             ::   NLUOUT
00301        REAL(KIND=JPRB) :: ZHOOK_HANDLE
00302        IF (LHOOK) CALL DR_HOOK('ERR_STOP',0,ZHOOK_HANDLE)
00303        WRITE(NLUOUT,*) ' '
00304        WRITE(NLUOUT,*) ' ARTICLE ',TRIM(HREC),' NOT FOUND IN FILE ', CFILEIN
00305        WRITE(NLUOUT,*) ' '
00306        WRITE(*,*) ' '
00307        WRITE(*,*) ' ARTICLE ',TRIM(HREC),' NOT FOUND IN FILE ', CFILEIN
00308        WRITE(*,*) ' '
00309        CALL ABOR1_SFX('SXPOST: ARTICLE '//HREC//' NOT FOUND')
00310        IF (LHOOK) CALL DR_HOOK('ERR_STOP',1,ZHOOK_HANDLE)
00311        END SUBROUTINE ERR_STOP
00312 
00313        END PROGRAM SXPOST