SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/LIB/TOPD/write_file

Go to the documentation of this file.
00001 !-----------------------------------------------------------------
00002 !     ##########################
00003       SUBROUTINE WRITE_FILE_MAP(PVAR,HVAR)
00004 !     ##########################
00005 !
00006 !!
00007 !!    PURPOSE
00008 !!    -------
00009 !        
00010 !     
00011 !!**  METHOD
00012 !!    ------
00013 !
00014 !!    EXTERNAL
00015 !!    --------
00016 !!
00017 !!    none
00018 !!
00019 !!    IMPLICIT ARGUMENTS
00020 !!    ------------------ 
00021 !!      
00022 !!    REFERENCE
00023 !!    ---------
00024 !!     
00025 !!    AUTHOR
00026 !!    ------
00027 !!
00028 !!      K. Chancibault  * Meteo-France *
00029 !!
00030 !!    MODIFICATIONS
00031 !!    -------------
00032 !!
00033 !!      Original   25/01/2005
00034 !-------------------------------------------------------------------------------
00035 !
00036 !*       0.     DECLARATIONS
00037 !               ------------
00038 !
00039 USE MODD_TOPODYN, ONLY : CCAT, NNCAT, NNYC, NNXC, XX0, XY0, XDXT, NLINE, &
00040                          XTOPD, XNUL
00041 !
00042 USE MODD_SURF_PAR, ONLY : XUNDEF
00043 !
00044 USE MODI_GET_LUOUT
00045 USE MODI_OPEN_FILE
00046 USE MODI_CLOSE_FILE
00047 !
00048 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00049 USE PARKIND1  ,ONLY : JPRB
00050 !
00051 IMPLICIT NONE
00052 !
00053 !*      0.1    declarations of arguments
00054 !
00055 REAL, DIMENSION(:,:), INTENT(IN) :: PVAR   ! variable to write in the file
00056  CHARACTER(LEN=30),    INTENT(IN) :: HVAR   ! end name of the file
00057 !
00058 !*      0.2    declarations of local variables
00059  CHARACTER(LEN=50),DIMENSION(NNCAT) :: CNAME
00060  CHARACTER(LEN=40)                  :: CFMT
00061  CHARACTER(*),PARAMETER     :: YPFMT1="('(',I4,'(F10.3,')"
00062 INTEGER                    :: JWRK1,JJ,JI,JCAT
00063 INTEGER                    :: IINDEX ! reference number of the pixel
00064 INTEGER                    :: IUNIT,ILUOUT
00065 REAL                       :: ZOUT ! pixel not included in the catchment
00066 REAL                       :: ZMIN,ZMAX
00067 REAL                       :: ZX1, ZY1, ZX2, ZY2 ! left top and right bottom pixels coordinates
00068 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00069 !-------------------------------------------------------------------------------
00070 IF (LHOOK) CALL DR_HOOK('WRITE_FILE_MAP',0,ZHOOK_HANDLE)
00071 !
00072 !*       0.     Initialization:
00073 !               ---------------
00074 !
00075  CALL GET_LUOUT('OFFLIN',ILUOUT)
00076 
00077 ZOUT = XUNDEF
00078 !
00079 DO JCAT=1,NNCAT
00080   !
00081   CNAME(JCAT) = TRIM(CCAT(JCAT))//TRIM(HVAR)
00082   !
00083   WRITE(ILUOUT,*) CNAME(JCAT)
00084   !
00085   CALL OPEN_FILE('ASCII ',IUNIT,HFILE=CNAME(JCAT),HFORM='FORMATTED')
00086   !
00087   !*       1.0    writing header map file
00088   !               --------------------------------------
00089   !
00090   IINDEX = (NNYC(JCAT)-1) * NNXC(JCAT) + 1
00091   !
00092   ZX1 = XX0(JCAT)
00093   ZY1 = XY0(JCAT) + ( (NNYC(JCAT)-1) * XDXT(JCAT) )
00094   !
00095   ZMIN = MINVAL(PVAR(JCAT,:))
00096   ZMAX = MAXVAL(PVAR(JCAT,:),MASK=PVAR(JCAT,:)/=XUNDEF)
00097   !
00098   DO JJ=1,5
00099     WRITE(IUNIT,*)
00100   ENDDO
00101   !
00102   WRITE(IUNIT,*) XX0(JCAT)
00103   WRITE(IUNIT,*) XY0(JCAT)
00104   WRITE(IUNIT,*) NNXC(JCAT) 
00105   WRITE(IUNIT,*) NNYC(JCAT)
00106   WRITE(IUNIT,*) ZOUT
00107   WRITE(IUNIT,*) XDXT(JCAT)
00108   WRITE(IUNIT,*) ZMIN
00109   WRITE(IUNIT,*) ZMAX
00110   !
00111   DO JJ=1,NNYC(JCAT)
00112     !
00113     DO JI=1,NNXC(JCAT)
00114       !
00115       IINDEX = (JJ - 1) * NNXC(JCAT) + JI
00116       ZX1 = XX0(JCAT) + ((JI-1) * XDXT(JCAT))
00117       ZY1 = XY0(JCAT) + ((JJ-1) * XDXT(JCAT))
00118       !
00119       IF ( XTOPD(JCAT,IINDEX).EQ.XNUL(JCAT) ) THEN
00120         !
00121         WRITE(IUNIT,*) ZOUT
00122         !
00123       ELSEIF (NLINE(JCAT,IINDEX)/=0) THEN
00124         !
00125         WRITE(IUNIT,*) PVAR(JCAT,NLINE(JCAT,IINDEX))
00126         !
00127       ELSE
00128         !
00129         WRITE(IUNIT,*) ZOUT
00130         !
00131       ENDIF
00132       !
00133     ENDDO
00134     !
00135   ENDDO
00136   !
00137   CALL CLOSE_FILE('ASCII ',IUNIT)
00138   !
00139 ENDDO
00140 !
00141 IF (LHOOK) CALL DR_HOOK('WRITE_FILE_MAP',1,ZHOOK_HANDLE)
00142 !
00143 END SUBROUTINE WRITE_FILE_MAP