| [207] | 1 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
|---|
| 2 | ! MODULE GRIDINFO_MODULE |
|---|
| 3 | ! |
|---|
| 4 | ! This module handles (i.e., acquires, stores, and makes available) all data |
|---|
| 5 | ! describing the model domains to be processed. |
|---|
| 6 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
|---|
| 7 | MODULE gridinfo_module |
|---|
| 8 | |
|---|
| 9 | USE misc_definitions_module |
|---|
| 10 | USE module_debug |
|---|
| 11 | USE module_model_basics |
|---|
| 12 | USE module_get_file_names |
|---|
| 13 | |
|---|
| 14 | ! Variables |
|---|
| 15 | integer :: interval_seconds, io_form_input |
|---|
| 16 | character (len=19) :: start_date, end_date |
|---|
| 17 | character (len=128) :: input_root_name, output_root_name |
|---|
| 18 | character (len=128) :: output_title |
|---|
| 19 | logical :: is_used, mercator_defs |
|---|
| 20 | logical :: keep_moist_arrays, keep_wind_arrays |
|---|
| 21 | integer :: interp_method |
|---|
| 22 | real, dimension(100) :: interp_levels |
|---|
| 23 | integer :: number_of_zlevs |
|---|
| 24 | real, allocatable, dimension(:,:,:) :: vert_array |
|---|
| 25 | character (len=4000) :: plot_these_fields |
|---|
| 26 | character (len=20) :: plot |
|---|
| 27 | character (len=5) :: output_type |
|---|
| 28 | |
|---|
| 29 | CONTAINS |
|---|
| 30 | |
|---|
| 31 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
|---|
| 32 | ! Name: get_namelist_params |
|---|
| 33 | ! Purpose: Read namelist parameters. |
|---|
| 34 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
|---|
| 35 | SUBROUTINE get_namelist_params() |
|---|
| 36 | |
|---|
| 37 | implicit none |
|---|
| 38 | |
|---|
| 39 | ! Local variables |
|---|
| 40 | integer :: start_year, start_month, start_day, start_hour, & |
|---|
| 41 | end_year, end_month, end_day, end_hour |
|---|
| 42 | integer :: funit, i |
|---|
| 43 | character (len=20) :: dummy |
|---|
| 44 | character (len=2000) :: fields,fields_file |
|---|
| 45 | namelist /datetime/ start_date, start_year, start_month, start_day, start_hour, & |
|---|
| 46 | end_date, end_year, end_month, end_day, end_hour, & |
|---|
| 47 | interval_seconds |
|---|
| 48 | namelist /io/ io_form_input, input_root_name, output_root_name, & |
|---|
| 49 | output_title, mercator_defs, & |
|---|
| 50 | keep_moist_arrays, keep_wind_arrays, & |
|---|
| 51 | plot, fields, fields_file, output_type |
|---|
| 52 | namelist /interp/ interp_method, interp_levels |
|---|
| 53 | |
|---|
| 54 | ! Set defaults |
|---|
| 55 | io_form_input = -1 |
|---|
| 56 | start_date = '0000-00-00_00:00:00' |
|---|
| 57 | end_date = '0000-00-00_00:00:00' |
|---|
| 58 | input_root_name = './' |
|---|
| 59 | output_root_name = './' |
|---|
| 60 | output_title = ' ' |
|---|
| 61 | plot = 'all' ! all, basic, file, list, all_file, all_list, basic_file, basic_list, list_file, all_list_file, basic_list_file |
|---|
| 62 | interp_method = 0 |
|---|
| 63 | vertical_type = 'n' |
|---|
| 64 | interp_levels = -99999. |
|---|
| 65 | mercator_defs = .FALSE. |
|---|
| 66 | keep_moist_arrays= .TRUE. |
|---|
| 67 | keep_wind_arrays = .TRUE. |
|---|
| 68 | output_type = 'grads' |
|---|
| 69 | |
|---|
| 70 | ! Read parameters from Fortran namelist |
|---|
| 71 | DO funit=10,100 |
|---|
| 72 | inquire(unit=funit, opened=is_used) |
|---|
| 73 | IF (.not. is_used) EXIT |
|---|
| 74 | END DO |
|---|
| 75 | OPEN(funit,file='namelist.ARWpost',status='old',form='formatted',err=1000) |
|---|
| 76 | |
|---|
| 77 | !MARS |
|---|
| 78 | ! aymeric: more practical |
|---|
| 79 | ! |
|---|
| 80 | READ(funit,io) |
|---|
| 81 | READ(funit,datetime) |
|---|
| 82 | ! READ(funit,io) |
|---|
| 83 | READ(funit,interp) |
|---|
| 84 | !WRITE(*,*) interp_levels |
|---|
| 85 | CLOSE(funit) |
|---|
| 86 | |
|---|
| 87 | ! Get all the input file names |
|---|
| 88 | CALL unix_ls ( input_root_name ) |
|---|
| 89 | |
|---|
| 90 | ! Check for valid io_form_input |
|---|
| 91 | IF ( & |
|---|
| 92 | #ifdef IO_BINARY |
|---|
| 93 | io_form_input /= BINARY .and. & |
|---|
| 94 | #endif |
|---|
| 95 | #ifdef IO_NETCDF |
|---|
| 96 | io_form_input /= NETCDF .and. & |
|---|
| 97 | #endif |
|---|
| 98 | #ifdef IO_GRIB1 |
|---|
| 99 | io_form_input /= GRIB1 .and. & |
|---|
| 100 | #endif |
|---|
| 101 | .true. ) then |
|---|
| 102 | write(6,*) ' ' |
|---|
| 103 | write(6,*) 'Error: No valid value for io_form_input was specified in the namelist.' |
|---|
| 104 | write(6,*) ' Valid io_form_input values are:' |
|---|
| 105 | #ifdef IO_BINARY |
|---|
| 106 | write(6,*) ' ',BINARY,' (=BINARY)' |
|---|
| 107 | #endif |
|---|
| 108 | #ifdef IO_NETCDF |
|---|
| 109 | write(6,*) ' ',NETCDF,' (=NETCDF)' |
|---|
| 110 | #endif |
|---|
| 111 | #ifdef IO_GRIB1 |
|---|
| 112 | write(6,*) ' ',GRIB1,' (=GRIB1)' |
|---|
| 113 | #endif |
|---|
| 114 | write(6,*) ' ' |
|---|
| 115 | STOP |
|---|
| 116 | END IF |
|---|
| 117 | |
|---|
| 118 | #ifdef IO_GRIB1 |
|---|
| 119 | IF (io_form_input == GRIB1) THEN |
|---|
| 120 | open (13, file = "gribinfo.txt") |
|---|
| 121 | END IF |
|---|
| 122 | #endif |
|---|
| 123 | |
|---|
| 124 | |
|---|
| 125 | IF (start_date == '0000-00-00_00:00:00') then |
|---|
| 126 | ! Build starting date string |
|---|
| 127 | WRITE(start_date, '(i4.4,a1,i2.2,a1,i2.2,a1,i2.2,a6)') & |
|---|
| 128 | start_year,'-',start_month,'-',start_day,' ',start_hour,':00:00' |
|---|
| 129 | |
|---|
| 130 | ! Build ending date string |
|---|
| 131 | WRITE(end_date, '(i4.4,a1,i2.2,a1,i2.2,a1,i2.2,a6)') & |
|---|
| 132 | end_year,'-',end_month,'-',end_day,' ',end_hour,':00:00' |
|---|
| 133 | END IF |
|---|
| 134 | |
|---|
| 135 | number_of_zlevs = 0 |
|---|
| 136 | IF (interp_method == -1 .or. interp_method == 0) interp_levels = -99999. |
|---|
| 137 | IF (abs(interp_method) == 1) vertical_type = 'z' |
|---|
| 138 | ! IF (interp_method == 1 .and. interp_levels(1) .gt. 100.) vertical_type = 'p' |
|---|
| 139 | !*****MARS |
|---|
| 140 | IF (interp_method == 1 .and. interp_levels(1) .gt. interp_levels(2)) vertical_type = 'p' |
|---|
| 141 | !!!!!!!!!!!!!!!! ajout octobre 2009 |
|---|
| 142 | IF (interp_method == 2) vertical_type = 'zabg' |
|---|
| 143 | !!!!!!!!!!!!!!!! |
|---|
| 144 | IF (interp_method == 1) THEN |
|---|
| 145 | DO |
|---|
| 146 | IF (interp_levels(number_of_zlevs+1) == -99999.) EXIT |
|---|
| 147 | number_of_zlevs = number_of_zlevs + 1 |
|---|
| 148 | END DO |
|---|
| 149 | ENDIF |
|---|
| 150 | |
|---|
| 151 | !! Which fields do we want. Options are: all, basic, file, list, all_file, all_list, basic_file, basic_list, list_file, all_list_file, basic_list_file |
|---|
| 152 | plot_these_fields = ',' |
|---|
| 153 | IF ( INDEX(plot,'basic') /= 0) & |
|---|
| 154 | plot_these_fields = & |
|---|
| 155 | ',HGT,HGT_M,MU,MUB,P,PB,PH,PHB,PSFC,T,TT,TSK,U,UU,U10,V,VV,V10,W' |
|---|
| 156 | ! |
|---|
| 157 | ! ',HGT,HGT_M,LANDMASK,LU_INDEX,MU,MUB,P,PB,PBLH,PH,PHB,PSFC, & |
|---|
| 158 | !&Q2,RAINC,RAINNC,SST,T,TT,T2,TH2,TMN,TSK,U,UU,U10,V,VV,V10,VEGFRA,W, & |
|---|
| 159 | !&XLAND,XLAT,XLAT_M,XLONG,XLONG_M,' |
|---|
| 160 | |
|---|
| 161 | IF ( INDEX(plot,'list') /= 0) THEN |
|---|
| 162 | DO i = 1 , len(fields) |
|---|
| 163 | IF (fields(i:i) /= ' ' ) THEN |
|---|
| 164 | plot_these_fields = trim(plot_these_fields)//fields(i:i) |
|---|
| 165 | ENDIF |
|---|
| 166 | END DO |
|---|
| 167 | plot_these_fields = trim(plot_these_fields)//"," |
|---|
| 168 | END IF |
|---|
| 169 | IF ( INDEX(plot,'file') /= 0) THEN |
|---|
| 170 | DO funit=10,100 |
|---|
| 171 | inquire(unit=funit, opened=is_used) |
|---|
| 172 | IF (.not. is_used) EXIT |
|---|
| 173 | END DO |
|---|
| 174 | OPEN(funit,file=fields_file,status='old',form='formatted',err=1001) |
|---|
| 175 | DO |
|---|
| 176 | READ(funit,*,END=999) dummy |
|---|
| 177 | plot_these_fields = trim(plot_these_fields)//trim(dummy)//"," |
|---|
| 178 | END DO |
|---|
| 179 | 999 CLOSE(funit) |
|---|
| 180 | END IF |
|---|
| 181 | |
|---|
| 182 | IF ( INDEX(plot,'all') /= 0 .and. output_type == 'v5d' ) THEN |
|---|
| 183 | CALL mprintf(.true.,ERROR,'ERROR: plot ALL not currently supported for VIS5D') |
|---|
| 184 | END IF |
|---|
| 185 | |
|---|
| 186 | RETURN |
|---|
| 187 | |
|---|
| 188 | 1000 CALL mprintf(.true.,ERROR,'Error opening file namelist.ARWpost') |
|---|
| 189 | RETURN |
|---|
| 190 | |
|---|
| 191 | !1001 CALL mprintf(.true.,ERROR,'Error opening fields input file') |
|---|
| 192 | 1001 CALL mprintf(.true.,STDOUT,' WARNING: Could not open fields input file: %s', s1=trim(fields_file) ) |
|---|
| 193 | CALL mprintf(.true.,STDOUT,' ') |
|---|
| 194 | RETURN |
|---|
| 195 | |
|---|
| 196 | END SUBROUTINE get_namelist_params |
|---|
| 197 | |
|---|
| 198 | END MODULE gridinfo_module |
|---|
