SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/write

Go to the documentation of this file.
00001 !     #########################
00002       SUBROUTINE WRITE_DATA(HPROGRAM)
00003 !     #########################
00004 !
00005 !!**** *WRITE_DATA* initializes cover-field correspondance arrays
00006 !!
00007 !!    PURPOSE
00008 !!    -------
00009 !!
00010 !!    METHOD
00011 !!    ------
00012 !!
00013 !!
00014 !!    EXTERNAL
00015 !!    --------
00016 !!
00017 !!    IMPLICIT ARGUMENTS
00018 !!    ------------------
00019 !!
00020 !!    REFERENCE
00021 !!    ---------
00022 !!
00023 !!    AUTHOR
00024 !!    ------
00025 !!
00026 !!    V. Masson        Meteo-France
00027 !!
00028 !!    MODIFICATION
00029 !!    ------------
00030 !!
00031 !!    Original    15/12/97
00032 !!    F.solmon    01/06/00 adaptation for patch approach
00033 !----------------------------------------------------------------------------
00034 !
00035 !*    0.     DECLARATION
00036 !            -----------
00037 
00038 USE MODD_SURF_PAR,       ONLY : XUNDEF
00039 !
00040 USE MODD_DATA_COVER,     ONLY : XDATA_TOWN, XDATA_NATURE, XDATA_SEA, XDATA_WATER, &
00041                                   XDATA_LAI, XDATA_VEGTYPE, XDATA_H_TREE,           &
00042                                   XDATA_GROUND_DEPTH, XDATA_ROOT_DEPTH,             &
00043                                   TDATA_SEED, TDATA_REAP, XDATA_WATSUP, XDATA_IRRIG,&
00044                                   XDATA_LAI_ALL_YEARS  
00045 USE MODD_DATA_COVER_PAR, ONLY : CNAMES
00046 !
00047 
00048 USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE, NVT_IRR, JPCOVER
00049 !
00050 !
00051 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00052 USE PARKIND1  ,ONLY : JPRB
00053 !
00054 IMPLICIT NONE
00055 !
00056 !*    0.1    Declaration of arguments
00057 !            ------------------------
00058 !
00059  CHARACTER(LEN=6),    INTENT(IN)    :: HPROGRAM     ! Type of program
00060 !
00061 !
00062 !*    0.2    Declaration of local variables
00063 !            ------------------------------
00064 !
00065 !
00066 INTEGER               :: JCOVER,JDEC,JK ! loop counters on covers, decades and vegtypes
00067 !
00068 
00069 !
00070 !*    0.3    Declaration of namelists
00071 !            ------------------------
00072 !
00073  CHARACTER(LEN=8), DIMENSION(12) :: CNVT
00074  CHARACTER(LEN=2) :: CF
00075 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00076 !-------------------------------------------------------------------------------
00077 IF (LHOOK) CALL DR_HOOK('WRITE_DATA',0,ZHOOK_HANDLE)
00078 CNVT(1) =  "NVT_NO  "      ! no vegetation (smooth)
00079 CNVT(2) =  "NVT_ROCK"      ! no vegetation (rocks)
00080 CNVT(3) =  "NVT_SNOW"      ! permanent snow and ice
00081 CNVT(4) =  "NVT_TREE"      ! forest and trees
00082 CNVT(5) =  "NVT_CONI"      ! forest and trees (coniferous)
00083 CNVT(6) =  "NVT_EVER"      ! forest and trees (broadleaf evergreen)
00084 CNVT(7) =  "NVT_C3  "      ! C3 cultures types
00085 CNVT(8) =  "NVT_C4  "      ! C4 cultures types
00086 CNVT(9) =  "NVT_IRR "      ! irrigated crops
00087 CNVT(10)=  "NVT_GRAS"      ! grassland
00088 CNVT(11)=  "NVT_TROG"      ! tropical grassland
00089 CNVT(12)=  "NVT_PARK"      ! peat bogs, parks and gardens (irrigated grass)
00090 
00091 DO JCOVER=301,JPCOVER
00092 WRITE(*,FMT='(A80)') '!-------------------------------------------------------------------------------'
00093 WRITE(*,FMT='(A16,I3.3)') 'SUBROUTINE COVER',JCOVER
00094 WRITE(*,FMT='(A1)') '!'
00095 WRITE(*,FMT='(A10,I3.3)') '!*   cover',JCOVER
00096 WRITE(*,FMT='(A5,A60)')   '!    ',CNAMES(JCOVER,1)
00097 WRITE(*,FMT='(A1)') '!'
00098 WRITE(*,FMT='(A7,I3)') 'ICOVER=',JCOVER
00099 WRITE(*,FMT='(A1)') '!'
00100 WRITE(*,FMT='(A21,F4.2)') 'XDATA_TOWN  (ICOVER)=',XDATA_TOWN(JCOVER)
00101 WRITE(*,FMT='(A21,F4.2)') 'XDATA_NATURE(ICOVER)=',XDATA_NATURE(JCOVER)
00102 WRITE(*,FMT='(A21,F4.2)') 'XDATA_WATER (ICOVER)=',XDATA_WATER(JCOVER)
00103 WRITE(*,FMT='(A21,F4.2)') 'XDATA_SEA   (ICOVER)=',XDATA_SEA(JCOVER)
00104 WRITE(*,FMT='(A1)') '!'
00105 DO JK=1,12
00106   IF (XDATA_VEGTYPE(JCOVER,JK)==0.) CYCLE
00107   IF (ALL(XDATA_LAI_ALL_YEARS(JCOVER,:,JK)==0.)) THEN
00108     WRITE(*,FMT='(A29,A8,A5)') &
00109            'XDATA_LAI_ALL_YEARS(ICOVER,:,',CNVT(JK),')= 0.'  
00110     CYCLE
00111   END IF
00112   WRITE(*,FMT='(A29,A8,A7)') &
00113            'XDATA_LAI_ALL_YEARS(ICOVER,:,',CNVT(JK),')= (/ &'  
00114   DO JDEC=1,18
00115     CF=', '
00116     IF (JDEC==18) CF='  '
00117     WRITE(*,FMT='(A7,12(F4.1,A2),A1)') '       ', &
00118          MAX(XDATA_LAI_ALL_YEARS(JCOVER,(JDEC-1)*12+1,JK),0.1),', ', &
00119          MAX(XDATA_LAI_ALL_YEARS(JCOVER,(JDEC-1)*12+2,JK),0.1),', ', &
00120          MAX(XDATA_LAI_ALL_YEARS(JCOVER,(JDEC-1)*12+3,JK),0.1),', ', &
00121          MAX(XDATA_LAI_ALL_YEARS(JCOVER,(JDEC-1)*12+4,JK),0.1),', ', &
00122          MAX(XDATA_LAI_ALL_YEARS(JCOVER,(JDEC-1)*12+5,JK),0.1),', ', &
00123          MAX(XDATA_LAI_ALL_YEARS(JCOVER,(JDEC-1)*12+6,JK),0.1),', ', &
00124          MAX(XDATA_LAI_ALL_YEARS(JCOVER,(JDEC-1)*12+7,JK),0.1),', ', &
00125          MAX(XDATA_LAI_ALL_YEARS(JCOVER,(JDEC-1)*12+8,JK),0.1),', ', &
00126          MAX(XDATA_LAI_ALL_YEARS(JCOVER,(JDEC-1)*12+9,JK),0.1),', ', &
00127          MAX(XDATA_LAI_ALL_YEARS(JCOVER,(JDEC-1)*12+10,JK),0.1),', ', &
00128          MAX(XDATA_LAI_ALL_YEARS(JCOVER,(JDEC-1)*12+11,JK),0.1),', ', &
00129          MAX(XDATA_LAI_ALL_YEARS(JCOVER,(JDEC-1)*12+12,JK),0.1),CF,'&'   
00130   END DO
00131   WRITE(*,FMT='(A7)') '     /)'
00132 END DO
00133 WRITE(*,FMT='(A1)') '!'
00134 DO JK=1,12
00135   IF (XDATA_VEGTYPE(JCOVER,JK)==0.) CYCLE
00136   WRITE(*,FMT='(A21,A8,A3,F4.2)') &
00137            'XDATA_VEGTYPE(ICOVER,',CNVT(JK),')= ',XDATA_VEGTYPE(JCOVER,JK)  
00138 END DO
00139 WRITE(*,FMT='(A1)') '!'
00140 DO JK=4,6
00141   IF (XDATA_VEGTYPE(JCOVER,JK)==0.) CYCLE
00142   WRITE(*,FMT='(A20,A8,A3,F4.1)') &
00143            'XDATA_H_TREE(ICOVER,',CNVT(JK),')= ',XDATA_H_TREE(JCOVER,JK)  
00144 END DO
00145 WRITE(*,FMT='(A1)') '!'
00146 DO JK=1,12
00147   IF (XDATA_VEGTYPE(JCOVER,JK)==0.) CYCLE
00148   WRITE(*,FMT='(A24,A8,A3,F4.1)') &
00149            'XDATA_ROOT_DEPTH(ICOVER,',CNVT(JK),')= ',XDATA_ROOT_DEPTH(JCOVER,JK)  
00150 END DO
00151 WRITE(*,FMT='(A1)') '!'
00152 DO JK=1,12
00153   IF (XDATA_VEGTYPE(JCOVER,JK)==0.) CYCLE
00154   WRITE(*,FMT='(A26,A8,A3,F4.1)') &
00155            'XDATA_GROUND_DEPTH(ICOVER,',CNVT(JK),')= ',XDATA_GROUND_DEPTH(JCOVER,JK)  
00156 END DO
00157 WRITE(*,FMT='(A1)') '!'
00158 IF (XDATA_VEGTYPE(JCOVER,9)/=0.) THEN
00159   WRITE(*,FMT='(A18,A8,A15,I2.2)') &
00160           'TDATA_SEED(ICOVER,',CNVT(9),')%TDATE%MONTH= ',TDATA_SEED(JCOVER,9)%TDATE%MONTH  
00161   WRITE(*,FMT='(A18,A8,A15,I2.2)') &
00162           'TDATA_SEED(ICOVER,',CNVT(9),')%TDATE%DAY  = ',TDATA_SEED(JCOVER,9)%TDATE%DAY  
00163   WRITE(*,FMT='(A18,A8,A15,I2.2)') &
00164           'TDATA_REAP(ICOVER,',CNVT(9),')%TDATE%MONTH= ',TDATA_REAP(JCOVER,9)%TDATE%MONTH  
00165   WRITE(*,FMT='(A18,A8,A15,I2.2)') &
00166           'TDATA_REAP(ICOVER,',CNVT(9),')%TDATE%DAY  = ',TDATA_REAP(JCOVER,9)%TDATE%DAY  
00167   WRITE(*,FMT='(A20,A8,A3,F4.1)') &
00168            'XDATA_WATSUP(ICOVER,',CNVT(9),')= ',XDATA_WATSUP(JCOVER,9)  
00169   WRITE(*,FMT='(A20,A8,A3,F4.1)') &
00170            'XDATA_IRRIG (ICOVER,',CNVT(9),')= ',XDATA_IRRIG (JCOVER,9)  
00171 END IF
00172 WRITE(*,FMT='(A20,I3.3)') 'END SUBROUTINE COVER',JCOVER
00173 END DO
00174 !-------------------------------------------------------------------------------
00175 !-------------------------------------------------------------------------------
00176 !-------------------------------------------------------------------------------
00177 !
00178 DO JCOVER=301,JPCOVER
00179   WRITE(*,FMT='(A10,I3.3)') 'CALL COVER',JCOVER
00180 END DO
00181 IF (LHOOK) CALL DR_HOOK('WRITE_DATA',1,ZHOOK_HANDLE)
00182 !-------------------------------------------------------------------------------
00183 !
00184 END SUBROUTINE WRITE_DATA