source: branches/ORCHIDEE_2_2/ORCHIDEE/src_oasisdriver/orchoasis_tools.f90 @ 6393

Last change on this file since 6393 was 3447, checked in by josefine.ghattas, 8 years ago

Integrated branch ORCHIDEE-DRIVER in the trunk. See #244
File size: 22.7 KB
Line 
1MODULE orchoasis_tools
2  !
3  USE defprec
4  USE netcdf
5  !
6  USE ioipsl_para
7  USE mod_orchidee_para
8  !
9#ifdef OASIS
10  USE mod_oasis
11  !
12  ! ORCHIDEE definitions
13  !
14  USE constantes
15  USE constantes_soil
16  USE constantes_mtc
17  USE pft_parameters
18  !
19  USE control
20  !
21  IMPLICIT NONE
22  !
23  PRIVATE
24  PUBLIC :: orchoasis_time, &
25       &    orchoasis_printpoint, orchoasis_defvar, orchoasis_getvar, &
26       &    orchoasis_putvar, orchoasis_printdate
27  !
28  !
29  !  Global variables
30  !
31  !
32  INTEGER(i_std), SAVE                               :: itau_offset  !! This offset is used to phase the
33  ! INPUT
34  INTEGER(i_std), SAVE :: il_part_id, tair_id, qair_id, zlevtq_id, zlevuv_id
35  INTEGER(i_std), SAVE :: rainf_id, snowf_id, lwdown_id, swnet_id, solarang_id
36  INTEGER(i_std), SAVE :: u_id, v_id, ps_id, cdrag_id
37  ! OUTPUT
38  INTEGER(i_std), SAVE :: vevapp_id, fluxsens_id, fluxlat_id, coastal_id, river_id
39  INTEGER(i_std), SAVE :: netco2_id, carblu_id, tsolrad_id, tsolnew_id, qsurf_id
40  INTEGER(i_std), SAVE :: albnir_id, albvis_id, emis_id, z0_id
41  !
42  LOGICAL, PARAMETER :: check_INPUTS = .FALSE.         !! (very) long print of INPUTs in intersurf
43  LOGICAL, SAVE :: check_time = .FALSE.
44  !
45  LOGICAL, SAVE :: landonly = .TRUE.
46  !
47  PUBLIC check_time
48  !
49CONTAINS
50!
51!=============================================================================================
52!
53  SUBROUTINE orchoasis_time(date_start, dt, nbdt)
54    !
55    !
56    ! This subroutine gets the start date of the simulation, the time step and the number
57    ! of time steps we need to do until the end of the simulations.
58    !
59    !
60    !
61    REAL(r_std), INTENT(out)                     :: date_start     !! The date at which the simulation starts
62    REAL(r_std), INTENT(out)                     :: dt             !! Time step length in seconds
63    INTEGER(i_std), INTENT(out)                  :: nbdt           !! Number of timesteps to be executed
64    !
65    ! Local
66    !
67    CHARACTER(LEN=20) :: str_sdate(2), str_edate(2), tmpstr
68    INTEGER(i_std) :: s_year, s_month, s_day, e_year, e_month, e_day
69    INTEGER(i_std) :: seci, hours, minutes
70    REAL(r_std) :: s_sec, e_sec, dateend, diff_sec, date_end
71    INTEGER(i_std) :: i, ic
72    !
73    !Config Key  = START_DATE
74    !Config Desc = Date at which the simulation starts
75    !Config Def  = NONE
76    !Config Help = The format is the same as in the CF convention : 1999-09-13 12:0:0
77    str_sdate = " "
78    CALL getin('START_DATE',str_sdate)
79    !
80    IF ( (INDEX(str_sdate(1),"-") .NE. INDEX(str_sdate(1),"-", .TRUE.)) .AND. &
81         &  (INDEX(str_sdate(2),":") .NE. INDEX(str_sdate(2),":", .TRUE.)) ) THEN
82       DO i=1,2
83          tmpstr = str_sdate(1)
84          ic = INDEX(tmpstr,"-")
85          tmpstr(ic:ic) = " "
86          str_sdate(1) = tmpstr
87          tmpstr = str_sdate(2)
88          ic = INDEX(tmpstr,":")
89          tmpstr(ic:ic) = " "
90          str_sdate(2) = tmpstr
91       ENDDO
92       READ (str_sdate(1),*) s_year, s_month, s_day
93       READ (str_sdate(2),*) hours, minutes, seci
94       s_sec = hours*3600. + minutes*60. + seci
95    ELSE
96       CALL ipslerr(3, "orchoasis_time", "START_DATE incorrectly specified in run.def", str_sdate(1), str_sdate(2))
97    ENDIF
98    CALL ymds2ju (s_year, s_month, s_day, s_sec, date_start)
99    CALL orchoasis_printdate(date_start, "This is after reading the start date")
100    !
101    !Config Key  = END_DATE
102    !Config Desc = Date at which the simulation ends
103    !Config Def  = NONE
104    !Config Help =  The format is the same as in the CF convention : 1999-09-13 12:0:0
105    str_edate = " "
106    CALL getin('END_DATE',str_edate)
107    !
108    IF ( (INDEX(str_edate(1),"-") .NE. INDEX(str_edate(1),"-", .TRUE.)) .AND. &
109         &  (INDEX(str_edate(2),":") .NE. INDEX(str_edate(2),":", .TRUE.)) ) THEN
110       DO i=1,2
111          tmpstr = str_edate(1)
112          ic = INDEX(tmpstr,"-")
113          tmpstr(ic:ic) = " "
114          str_edate(1) = tmpstr
115          tmpstr = str_edate(2)
116          ic = INDEX(tmpstr,":")
117          tmpstr(ic:ic) = " "
118          str_edate(2) = tmpstr
119       ENDDO
120       READ (str_edate(1),*) e_year, e_month, e_day
121       READ (str_edate(2),*) hours, minutes, seci
122       e_sec = hours*3600. + minutes*60. + seci
123    ELSE
124       CALL ipslerr(3, "orchoasis_time", "END_DATE incorrectly specified in run.def", str_edate(1), str_edate(2))
125    ENDIF
126    CALL ymds2ju (e_year, e_month, e_day, e_sec, date_end)
127    CALL orchoasis_printdate(date_start, "This is after reading the end date")
128    !
129    CALL time_diff (s_year,s_month,s_day,s_sec,e_year,e_month,e_day,e_sec,diff_sec)
130    !
131    !Config Key  = DT_SECHIBA
132    !Config Desc = Time step length in seconds for Sechiba component
133    !Config Def  = 1800
134    !Config Help =
135    !Config Units = [seconds]
136    dt = 1800
137    CALL getin('DT_SECHIBA', dt)
138    !
139    nbdt = NINT(diff_sec/dt)
140    !
141  END SUBROUTINE orchoasis_time
142!
143!=============================================================================================
144!
145  SUBROUTINE orchoasis_printpoint(julian_day, lon_pt, lat_pt, nbind, lalo, var, message, ktest)
146    !
147    REAL(r_std), INTENT(in) :: julian_day
148    REAL(r_std), INTENT(in) :: lon_pt, lat_pt
149    INTEGER(i_std), INTENT(in) :: nbind
150    REAL(r_std), INTENT(in) :: lalo(:,:)
151    REAL(r_std), INTENT(in) :: var(:)
152    CHARACTER(len=*), INTENT(in) :: message
153    INTEGER(i_std), OPTIONAL, INTENT(out) :: ktest
154    !
155    !
156    !
157    INTEGER(i_std) :: year, month, day, hours, minutes, seci
158    REAL(r_std) :: sec, mindist
159    REAL(r_std), ALLOCATABLE, DIMENSION(:) :: dist, refdist
160    INTEGER(i_std) :: lon_ind, lat_ind, ind
161    INTEGER(i_std) :: i, imin(1)
162    REAL(r_std), PARAMETER :: mincos  = 0.0001
163    REAL(r_std), PARAMETER :: pi = 3.141592653589793238
164    REAL(r_std), PARAMETER :: R_Earth = 6378000.
165    !
166    ! Check if there is anything to be done
167    !
168    IF ( MAX(lon_pt, lat_pt) > 360.0 ) THEN
169       IF ( PRESENT(ktest) ) ktest = -1
170       RETURN
171    ENDIF
172    !
173    ! Allocate memory
174    !
175    ALLOCATE(dist(nbind))
176    ALLOCATE(refdist(nbind))
177    !
178    ! Convert time first
179    !
180    CALL ju2ymds (julian_day, year, month, day, sec)
181    hours = INT(sec/3600)
182    sec = sec - 3600 * hours
183    minutes = INT(sec / 60)
184    sec = sec - 60 * minutes
185    seci = INT(sec)
186    !
187    ! Get the location to be analysed
188    !
189    DO i=1,nbind
190       dist(i) = acos( sin(lat_pt*pi/180)*sin(lalo(i,1)*pi/180) + &
191            &    cos(lat_pt*pi/180)*cos(lalo(i,1)*pi/180)*cos((lalo(i,2)-lon_pt)*pi/180) ) * R_Earth
192    ENDDO
193    !
194    ! Look for the next grid point closest to the one with the smalest distance.
195    !
196    imin = MINLOC(dist)
197    DO i=1,nbind
198       refdist(i) = acos( sin(lalo(imin(1),1)*pi/180)*sin(lalo(i,1)*pi/180) + &
199            &       cos(lalo(imin(1),1)*pi/180)*cos(lalo(i,1)*pi/180) * cos((lalo(i,2)-lalo(imin(1),2))*pi/180) ) * R_Earth
200    ENDDO
201    refdist(imin(1)) =  MAXVAL(refdist)
202    mindist = MINVAL(refdist)
203    !
204    ! Are we closer than the closest points ?
205    !
206    IF ( PRESENT(ktest) ) ktest = -1
207    IF ( dist(imin(1)) <= mindist ) THEN
208       !
209       WRITE(numout,"(I2.2,':',I2.2,':',I2.2,' Loc : ', F6.1,',', F6.1,'(i=',I6,') Value = ',F12.4,A38)") &
210            & hours, minutes, seci, lalo(imin(1),2), lalo(imin(1),1), imin(1), var(imin(1)), message
211       !
212       IF ( PRESENT(ktest) ) ktest = imin(1)
213    ENDIF
214    !
215  END SUBROUTINE orchoasis_printpoint
216  !
217  !-------------------------------------------------------------------------------------------------------
218  !-
219  !- orchoasis_defvar
220  !-
221  !-------------------------------------------------------------------------------------------------------
222  SUBROUTINE orchoasis_defvar (mpi_rank, kjpindex)
223    !
224    ! ARGUMENTS
225    !
226    INTEGER(i_std), INTENT(in) :: mpi_rank, kjpindex
227    !
228    ! LOCAL
229    !
230    INTEGER(i_std)               :: ierror, tot_error
231    INTEGER(i_std), DIMENSION(3) :: ig_paral
232    INTEGER(i_std), DIMENSION(2) :: var_nodims, var_shape
233    CHARACTER(LEN=8) :: varname
234    !
235    !
236    !Config Key  = COUPLING_LANDONLY
237    !Config Desc = Specifies if the OASIS coupler will provide only data on land or on land and ocean.
238    !Config Def  = TRUE
239    !Config Help = If COUPLING_LANDONLY is set to TRUE, then ORCHIDEE expects to receive only land points
240    !              from OASIS. On the contrary data on both land and ocean will be received and the arrays
241    !              re-indexed so as to keep only land points.
242    landonly = .TRUE.
243    CALL getin('COUPLING_LANDONLY',landonly)
244    !
245    tot_error = 0
246    !
247    IF ( landonly ) THEN
248       ig_paral(1) = 1
249       ig_paral(2) = nbp_mpi_para_begin(mpi_rank)-1
250       ig_paral(3) = kjpindex
251    ELSE
252       ig_paral(1) = 1
253       ig_paral(2) = ij_para_begin(mpi_rank) - 1
254       ig_paral(3) = ij_nb
255    ENDIF
256
257    WRITE(*,*) mpi_rank, "Start and length =",  ig_paral(2:3)
258
259    CALL oasis_def_partition (il_part_id, ig_paral, ierror)
260
261    IF ( landonly ) THEN
262       var_nodims(1) = 1
263       var_nodims(2) = 1
264       var_shape(1) = 1
265       var_shape(1) = kjpindex
266    ELSE
267       var_nodims(1) = 1
268       var_nodims(2) = 1
269       var_shape(1) = 1
270       var_shape(1) = ij_nb
271    ENDIF
272    !
273    ! ORCHIDEE's Input variables
274    ! ===========================
275    !
276    !
277    ! Define levels
278    !
279    varname="HEIGHTTQ"
280    CALL oasis_def_var(zlevtq_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
281    tot_error = tot_error+ierror
282    !
283    varname="HEIGHTUV"
284    CALL oasis_def_var(zlevuv_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
285    tot_error = tot_error+ierror
286    !
287    !
288    varname="TEMPLEV1"
289    CALL oasis_def_var(tair_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
290    tot_error = tot_error+ierror
291    varname="HUMILEV1"
292    CALL oasis_def_var(qair_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
293    tot_error = tot_error+ierror
294    !
295    ! Define precipitation variables
296    !
297    varname="RAINFALL"
298    CALL oasis_def_var(rainf_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
299    tot_error = tot_error+ierror
300    varname="SNOWFALL"
301    CALL oasis_def_var(snowf_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
302    tot_error = tot_error+ierror
303    !
304    !
305    ! Define precipitation variables
306    !
307    varname="SHORTNET"
308    CALL oasis_def_var(swnet_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
309    tot_error = tot_error+ierror
310    varname="LONWDOWN"
311    CALL oasis_def_var(lwdown_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
312    tot_error = tot_error+ierror
313    varname="SOLARANG"
314    CALL oasis_def_var(solarang_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
315    tot_error = tot_error+ierror
316    !
317    ! Define dynamical variables
318    !
319    varname="EASTWIND"
320    CALL oasis_def_var(u_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
321    tot_error = tot_error+ierror
322    varname="NORTWIND"
323    CALL oasis_def_var(v_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
324    tot_error = tot_error+ierror
325    varname="SURFPRES"
326    CALL oasis_def_var(ps_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
327    tot_error = tot_error+ierror
328    varname="MODCDRAG"
329    CALL oasis_def_var(cdrag_id, varname, il_part_id, var_nodims, OASIS_In, var_shape, OASIS_Real, ierror)
330    tot_error = tot_error+ierror
331    !
332    ! ORCHIDEE's Output variables
333    ! ===========================
334    !
335    ! Turbulent fluxes
336    !
337    varname="TOTEVAPS"
338    CALL oasis_def_var(vevapp_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
339    tot_error = tot_error+ierror
340    !
341    varname="FLUXSENS"
342    CALL oasis_def_var(fluxsens_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
343    tot_error = tot_error+ierror
344    !
345    varname="FLUXLATE"
346    CALL oasis_def_var(fluxlat_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
347    tot_error = tot_error+ierror
348    !
349    ! Discharge to the oceans
350    !
351    varname="COASTFLO"
352    CALL oasis_def_var(coastal_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
353    tot_error = tot_error+ierror
354    !
355    varname="RIVERFLO"
356    CALL oasis_def_var(river_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
357    tot_error = tot_error+ierror
358    !
359    ! Carbon fluxes
360    !
361    varname="FLUNECO2"
362    CALL oasis_def_var(netco2_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
363    tot_error = tot_error+ierror
364    !
365    varname="FLULUCO2"
366    CALL oasis_def_var(carblu_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
367    tot_error = tot_error+ierror
368    !
369    ! Surface states
370    !
371    varname="TSURFRAD"
372    CALL oasis_def_var(tsolrad_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
373    tot_error = tot_error+ierror
374    !
375    varname="TSURFNEW"
376    CALL oasis_def_var(tsolnew_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
377    tot_error = tot_error+ierror
378    !
379    varname="QSURFNEW"
380    CALL oasis_def_var(qsurf_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
381    tot_error = tot_error+ierror
382    !
383    varname="ALBEDVIS"
384    CALL oasis_def_var(albvis_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
385    tot_error = tot_error+ierror
386    !
387    varname="ALBEDNIR"
388    CALL oasis_def_var(albnir_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
389    tot_error = tot_error+ierror
390    !
391    varname="EMISLONW"
392    CALL oasis_def_var(emis_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
393    tot_error = tot_error+ierror
394    !
395    varname="ROUGNESS"
396    CALL oasis_def_var(z0_id, varname, il_part_id, var_nodims, OASIS_Out, var_shape, OASIS_Real, ierror)
397    tot_error = tot_error+ierror
398    !
399    IF ( tot_error .NE. 0 ) THEN
400       CALL ipslerr(3, "orchoasis_defvar", "Definition of one of the coupling variables failed.", &
401            &          "No futher information can be given at this point.", "")
402    ENDIF
403    !
404    CALL oasis_enddef (ierror)
405    !
406    IF ( ierror .NE. 0 ) THEN
407       CALL ipslerr(3, "orchoasis_defvar", "End of the definition of coupling variables failed.", &
408            &          "If OASIS has a way to decide the error status it should be put here.", "")
409    ENDIF
410    !
411  END SUBROUTINE orchoasis_defvar
412  !-------------------------------------------------------------------------------------------------------
413  !-
414  !- orchoasis_getvar
415  !-
416  !-------------------------------------------------------------------------------------------------------
417  SUBROUTINE orchoasis_getvar (itau, dt, kjpindex, landindex, zlev_tq, zlev_uv, temp_air, qair, precip_rain, &
418       &                      precip_snow, swnet, lwdown, sinang, u, v, pb, cdrag)
419    !
420    ! ARGUMENTS
421    !
422    INTEGER(i_std), INTENT(in) :: itau, kjpindex
423    INTEGER(i_std), DIMENSION(kjpindex), INTENT(in) :: landindex
424    REAL(r_std), INTENT(in)    :: dt
425    !
426    REAL(r_std), DIMENSION(kjpindex), INTENT(out) :: zlev_tq, zlev_uv, temp_air, qair, precip_rain
427    REAL(r_std), DIMENSION(kjpindex), INTENT(out) :: precip_snow, swnet, lwdown, sinang, u, v, pb
428    REAL(r_std), DIMENSION(kjpindex), INTENT(out) :: cdrag
429    !
430    ! LOCAL
431    !
432    INTEGER(i_std) :: oasis_info
433    REAL(r_std), ALLOCATABLE, DIMENSION(:) :: buffer
434    !
435    ! Dimension the buffer for getting the data from OASIS according to the number of
436    ! points we will get : with or without ocean points.
437    !
438    IF ( .NOT. ALLOCATED(buffer) ) THEN
439       IF ( landonly ) THEN
440          ALLOCATE(buffer(kjpindex))
441       ELSE
442          ALLOCATE(buffer(ij_nb))
443       ENDIF
444    ENDIF
445    !
446    ! Get first the levels
447    !
448    CALL oasis_get(zlevtq_id, NINT(itau*dt), buffer, oasis_info)
449    IF ( landonly ) THEN
450       zlev_tq = buffer
451    ELSE
452       zlev_tq = buffer(landindex)
453    ENDIF
454    CALL oasis_get(zlevuv_id, NINT(itau*dt), buffer, oasis_info)
455    IF ( landonly ) THEN
456       zlev_uv = buffer
457    ELSE
458       zlev_uv = buffer(landindex)
459    ENDIF
460    !
461    ! Get atmospheric state variables
462    !
463    CALL oasis_get(tair_id, NINT(itau*dt), buffer, oasis_info)
464    IF ( landonly ) THEN
465       temp_air = buffer
466    ELSE
467       temp_air = buffer(landindex)
468    ENDIF
469    CALL oasis_get(qair_id, NINT(itau*dt), buffer, oasis_info)
470    IF ( landonly ) THEN
471       qair = buffer
472    ELSE
473       qair = buffer(landindex)
474    ENDIF
475    !
476    ! Get precipitation fluxes
477    !
478    CALL oasis_get(rainf_id, NINT(itau*dt), buffer, oasis_info)
479    IF ( landonly ) THEN
480       precip_rain = buffer
481    ELSE
482       precip_rain = buffer(landindex)
483    ENDIF
484    CALL oasis_get(snowf_id, NINT(itau*dt), buffer, oasis_info)
485    IF ( landonly ) THEN
486       precip_snow = buffer
487    ELSE
488       precip_snow = buffer(landindex)
489    ENDIF
490    !
491    ! Get Radiation fluxes
492    !
493    CALL oasis_get(swnet_id, NINT(itau*dt), buffer, oasis_info)
494    IF ( landonly ) THEN
495       swnet = buffer
496    ELSE
497       swnet = buffer(landindex)
498    ENDIF
499    CALL oasis_get(lwdown_id, NINT(itau*dt), buffer, oasis_info)
500    IF ( landonly ) THEN
501       lwdown = buffer
502    ELSE
503       lwdown = buffer(landindex)
504    ENDIF
505    CALL oasis_get(solarang_id, NINT(itau*dt), buffer, oasis_info)
506    IF ( landonly ) THEN
507       sinang = buffer
508    ELSE
509       sinang = buffer(landindex)
510    ENDIF
511    !
512    ! Get dynamical variables
513    !
514    CALL oasis_get(u_id, NINT(itau*dt), buffer, oasis_info)
515    IF ( landonly ) THEN
516       u = buffer
517    ELSE
518       u = buffer(landindex)
519    ENDIF
520    CALL oasis_get(v_id, NINT(itau*dt), buffer, oasis_info)
521    IF ( landonly ) THEN
522       v = buffer
523    ELSE
524       v = buffer(landindex)
525    ENDIF
526    CALL oasis_get(ps_id, NINT(itau*dt), buffer, oasis_info)
527    IF ( landonly ) THEN
528       pb = buffer
529    ELSE
530       pb = buffer(landindex)
531    ENDIF
532    CALL oasis_get(cdrag_id, NINT(itau*dt), buffer, oasis_info)
533    IF ( landonly ) THEN
534       cdrag = buffer
535    ELSE
536       cdrag = buffer(landindex)
537    ENDIF
538    !
539  END SUBROUTINE orchoasis_getvar
540  !
541  !-------------------------------------------------------------------------------------------------------
542  !-
543  !- orchoasis_putvar
544  !-
545  !-------------------------------------------------------------------------------------------------------
546  SUBROUTINE orchoasis_putvar(itau, dt, kjpindex, landindex, vevapp, fluxsens, fluxlat, coastalflow, riverflow, &
547       &                      netco2, carblu, tsol_rad, temp_sol_new, qsurf, albedo, emis, z0)
548    !
549    ! ARGUMENTS
550    !
551    INTEGER(i_std), INTENT(in) :: itau, kjpindex
552    INTEGER(i_std), DIMENSION(kjpindex), INTENT(in) :: landindex
553    REAL(r_std), INTENT(in)    :: dt
554    !
555    REAL(r_std), DIMENSION(kjpindex), INTENT(in) :: vevapp, fluxsens, fluxlat, coastalflow, riverflow
556    REAL(r_std), DIMENSION(kjpindex), INTENT(in) :: netco2, carblu, tsol_rad, temp_sol_new, qsurf, emis, z0
557    REAL(r_std), DIMENSION(kjpindex,2), INTENT(in) :: albedo
558    !
559    ! LOCAL
560    !
561    INTEGER(i_std) :: oasis_info
562    REAL(r_std), ALLOCATABLE, DIMENSION(:) :: buffer
563    !
564    IF ( .NOT. ALLOCATED(buffer) ) THEN
565       IF ( landonly ) THEN
566          ALLOCATE(buffer(kjpindex))
567       ELSE
568          ALLOCATE(buffer(ij_nb))
569       ENDIF
570    ENDIF
571    !
572    ! Set all points to undef. This is the value which will remain over ocean points.
573    !
574    buffer(:) = undef_sechiba
575    !
576    ! Turbulent fluxes
577    !
578    IF ( landonly ) THEN
579       buffer(:) = vevapp(:)
580    ELSE
581       buffer(landindex(:)) = vevapp(:)
582    ENDIF
583    CALL oasis_put(vevapp_id, NINT(itau*dt), buffer, oasis_info)
584    IF ( landonly ) THEN
585       buffer(:) = fluxsens(:)
586    ELSE
587       buffer(landindex(:)) = fluxsens(:)
588    ENDIF
589    CALL oasis_put(fluxsens_id, NINT(itau*dt), buffer, oasis_info)
590    IF ( landonly ) THEN
591       buffer(:) = fluxlat(:)
592    ELSE
593       buffer(landindex(:)) = fluxlat(:)
594    ENDIF
595    CALL oasis_put(fluxlat_id, NINT(itau*dt), buffer, oasis_info)
596    !
597    ! Water fluxes to the ocean
598    !
599    IF ( landonly ) THEN
600       buffer(:) = coastalflow(:)
601    ELSE
602       buffer(landindex(:)) = coastalflow(:)
603    ENDIF
604    CALL oasis_put(coastal_id, NINT(itau*dt), buffer, oasis_info)
605    IF ( landonly ) THEN
606       buffer(:) = riverflow(:)
607    ELSE
608       buffer(landindex(:)) = riverflow(:)
609    ENDIF
610    CALL oasis_put(river_id, NINT(itau*dt), buffer, oasis_info)
611    !
612    ! Carbon
613    !
614    IF ( landonly ) THEN
615       buffer(:) = netco2(:)
616    ELSE
617       buffer(landindex(:)) = netco2(:)
618    ENDIF
619    CALL oasis_put(netco2_id, NINT(itau*dt), buffer, oasis_info)
620    IF ( landonly ) THEN
621       buffer(:) = carblu(:)
622    ELSE
623       buffer(landindex(:)) = carblu(:)
624    ENDIF
625    CALL oasis_put(carblu_id, NINT(itau*dt), buffer, oasis_info)
626    !
627    ! Surface conditions
628    !
629    IF ( landonly ) THEN
630       buffer(:) = tsol_rad(:)
631    ELSE
632       buffer(landindex(:)) = tsol_rad(:)
633    ENDIF
634    CALL oasis_put(tsolrad_id, NINT(itau*dt), buffer, oasis_info)
635    IF ( landonly ) THEN
636       buffer(:) = temp_sol_new(:)
637    ELSE
638       buffer(landindex(:)) = temp_sol_new(:)
639    ENDIF
640    CALL oasis_put(tsolnew_id, NINT(itau*dt), buffer, oasis_info)
641    IF ( landonly ) THEN
642       buffer(:) = qsurf(:)
643    ELSE
644       buffer(landindex(:)) = qsurf(:)
645    ENDIF
646    CALL oasis_put(qsurf_id, NINT(itau*dt), buffer, oasis_info)
647    !
648    ! Other surface conditions
649    !
650    IF ( landonly ) THEN
651       buffer(:) = albedo(:,ivis)
652    ELSE
653       buffer(landindex(:)) = albedo(:,ivis)
654    ENDIF
655    CALL oasis_put(albvis_id, NINT(itau*dt), buffer, oasis_info)
656    IF ( landonly ) THEN
657       buffer(:) = albedo(:,inir)
658    ELSE
659       buffer(landindex(:)) = albedo(:,inir)
660    ENDIF
661    CALL oasis_put(albnir_id, NINT(itau*dt), buffer, oasis_info)
662    IF ( landonly ) THEN
663       buffer(:) = emis(:)
664    ELSE
665       buffer(landindex(:)) = emis(:)
666    ENDIF
667    CALL oasis_put(emis_id, NINT(itau*dt), buffer, oasis_info)
668    IF ( landonly ) THEN
669       buffer(:) = z0(:)
670    ELSE
671       buffer(landindex(:)) = z0(:)
672    ENDIF
673    CALL oasis_put(z0_id, NINT(itau*dt), buffer, oasis_info)
674    !
675  END SUBROUTINE orchoasis_putvar
676!
677!=============================================================================================
678!
679  SUBROUTINE orchoasis_printdate(julian_day, message)
680    !
681    REAL(r_std), INTENT(in) :: julian_day
682    CHARACTER(len=*), INTENT(in) :: message
683    !
684    !
685    !
686    INTEGER(i_std) :: year, month, day, hours, minutes, seci
687    REAL(r_std) :: sec
688    !
689    CALL ju2ymds (julian_day, year, month, day, sec)
690    hours = INT(sec/3600)
691    sec = sec - 3600 * hours
692    minutes = INT(sec / 60)
693    sec = sec - 60 * minutes
694    seci = INT(sec)
695    !
696    WRITE(*,'(I4.4,"-",I2.2,"-",I2.2," ",I2.2,":",I2.2,":",I2.2," > ", A60)') &
697         &            year, month, day, hours, minutes, seci, message
698    !
699  END SUBROUTINE orchoasis_printdate
700  !
701  !
702#endif
703END MODULE orchoasis_tools
Note: See TracBrowser for help on using the repository browser.