Changeset 7262 for branches/ORCHIDEE_2_2
- Timestamp:
- 2021-07-27T19:02:48+02:00 (3 years ago)
- Location:
- branches/ORCHIDEE_2_2/ORCHIDEE/src_driver
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/ORCHIDEE_2_2/ORCHIDEE/src_driver/forcing_tools.f90
r7258 r7262 204 204 REAL(r_std) :: s_sec, e_sec, dateend, diff_sec, date_end 205 205 INTEGER(i_std) :: i, ic 206 CHARACTER(LEN=20) :: str_cyclic_start(2), str_cyclic_end(2) 207 INTEGER(i_std) :: c_year_start, c_month_start, c_day_start, c_year_end, c_month_end, c_day_end 208 REAL(r_std) :: c_sec_start, c_sec_end 206 209 ! 207 210 !Config Key = START_DATE … … 212 215 CALL getin('START_DATE',str_sdate) 213 216 ! 217 !Config Key = CYCLIC_STARTDATE 218 !Config Desc = Date at which the cyclic year is started 219 !Config Def = NONE 220 !Config Help = The format is the same as in the CF convention : 1999-09-13 12:0:0 221 str_cyclic_start = " " 222 CALL getin('CYCLIC_STARTDATE',str_cyclic_start) 223 224 ! 225 !Config Key = CYCLIC_ENDDATE 226 !Config Desc = Date at which the cyclic year is ended 227 !Config Def = NONE 228 !Config Help = The format is the same as in the CF convention : 1999-09-13 12:0:0 229 str_cyclic_end = " " 230 CALL getin('CYCLIC_ENDDATE',str_cyclic_end) 231 232 233 ! 234 ! the start date of simulation 214 235 IF ( (INDEX(str_sdate(1),"-") .NE. INDEX(str_sdate(1),"-", .TRUE.)) .AND. & 215 236 & (INDEX(str_sdate(2),":") .NE. INDEX(str_sdate(2),":", .TRUE.)) ) THEN … … 230 251 CALL ipslerr(3, "forcing_integration_time", "START_DATE incorrectly specified in run.def", str_sdate(1), str_sdate(2)) 231 252 ENDIF 232 CALL ymds2ju (s_year, s_month, s_day, s_sec, date_start) 253 !--------------------------------- 254 ! cyclic start date 255 IF ( (INDEX(str_cyclic_start(1),"-") .NE. INDEX(str_cyclic_start(1),"-", .TRUE.)) .AND. & 256 & (INDEX(str_cyclic_start(2),":") .NE. INDEX(str_cyclic_start(2),":", .TRUE.)) ) THEN 257 DO i=1,2 258 tmpstr = str_cyclic_start(1) 259 ic = INDEX(tmpstr,"-") 260 tmpstr(ic:ic) = " " 261 str_cyclic_start(1) = tmpstr 262 tmpstr = str_cyclic_start(2) 263 ic = INDEX(tmpstr,":") 264 tmpstr(ic:ic) = " " 265 str_cyclic_start(2) = tmpstr 266 ENDDO 267 READ (str_cyclic_start(1),*) c_year_start, c_month_start, c_day_start 268 READ (str_cyclic_start(2),*) hours, minutes, seci 269 c_sec_start = hours*3600. + minutes*60. + seci 270 ELSE IF ( len_trim(str_cyclic_start(1)) .NE. 0 ) THEN 271 CALL ipslerr(3, "forcing_integration_time", "CYCLIC_STARTDATE incorrectly specified in run.def", str_cyclic_start(1), str_cyclic_start(2)) 272 ENDIF 273 ! if s_year not the same as c_year, use cyear to compute date_start 274 IF ( ( s_year .NE. c_year_start) .AND. (len_trim(str_cyclic_start(1)) .NE. 0)) THEN 275 CALL ymds2ju (c_year_start, c_month_start, c_day_start, c_sec_start, date_start) 276 ELSE 277 CALL ymds2ju (s_year, s_month, s_day, s_sec, date_start) 278 ENDIF 233 279 CALL forcing_printdate(date_start, "This is after reading the start date") 280 234 281 ! 235 282 !Config Key = END_DATE … … 258 305 CALL ipslerr(3, "forcing_integration_time", "END_DATE incorrectly specified in run.def", str_edate(1), str_edate(2)) 259 306 ENDIF 260 CALL ymds2ju (e_year, e_month, e_day, e_sec, date_end) 261 ! 262 CALL time_diff (s_year,s_month,s_day,s_sec,e_year,e_month,e_day,e_sec,diff_sec) 307 308 !--------------------------------- 309 ! for cyclic end date 310 IF ( (INDEX(str_cyclic_end(1),"-") .NE. INDEX(str_cyclic_end(1),"-", .TRUE.)) .AND. & 311 & (INDEX(str_cyclic_end(2),":") .NE. INDEX(str_cyclic_end(2),":", .TRUE.)) ) THEN 312 DO i=1,2 313 tmpstr = str_cyclic_end(1) 314 ic = INDEX(tmpstr,"-") 315 tmpstr(ic:ic) = " " 316 str_cyclic_end(1) = tmpstr 317 tmpstr = str_cyclic_end(2) 318 ic = INDEX(tmpstr,":") 319 tmpstr(ic:ic) = " " 320 str_cyclic_end(2) = tmpstr 321 ENDDO 322 READ (str_cyclic_end(1),*) c_year_end, c_month_end, c_day_end 323 READ (str_cyclic_end(2),*) hours, minutes, seci 324 c_sec_end = hours*3600. + minutes*60. + seci 325 ELSE IF ( len_trim(str_cyclic_end(1)) .NE. 0 ) THEN 326 CALL ipslerr(3, "forcing_integration_time", "CYCLIC_ENDDATE incorrectly specified in run.def", str_cyclic_end(1), str_cyclic_end(2)) 327 ENDif 328 329 ! if e_year not the same as c_year_end, use cyear_end to compute date_end 330 IF (( e_year .NE. c_year_end) .AND. (len_trim(str_cyclic_end(1)) .NE. 0) )THEN 331 CALL ymds2ju (c_year_end, c_month_end, c_day_end, c_sec_end, date_end) 332 ELSE 333 CALL ymds2ju (e_year, e_month, e_day, e_sec, date_end) 334 ENDIF 335 336 ! 337 IF (( s_year .NE. c_year_start) .AND. (len_trim(str_cyclic_start(1)) .NE. 0) )then 338 CALL time_diff (c_year_start,c_month_start,c_day_start,c_sec_start,c_year_end,c_month_end,c_day_end,c_sec_end,diff_sec) 339 ELSE 340 CALL time_diff (s_year,s_month,s_day,s_sec,e_year,e_month,e_day,e_sec,diff_sec) 341 ENDIF 342 263 343 ! 264 344 !Config Key = DT_SECHIBA … … 403 483 ENDIF 404 484 CALL forcing_getglogrid(nb_forcefile, forfilename, iim_tmp, jjm_tmp, nbpoint_tmp, .FALSE., landonly) 485 405 486 ! 406 487 IF ( PRESENT(wunit) ) THEN … … 429 510 nbpoint_loc = nbpoint_in 430 511 ENDIF 512 431 513 ! 432 514 ! Treat the time dimension now : … … 453 535 ENDIF 454 536 CALL forcing_integration_time(startdate, dt, nbdt) 455 ! 537 456 538 ! Test that the time interval requested by the user correspond to the time available in the 457 539 ! forcing file. … … 463 545 CALL ipslerr (3,'forcing_open', 'Start time requested by the user is outside of the time interval',& 464 546 & "covered by the forcing file.","Please verify the configuration in the run.def file.") 547 465 548 ENDIF 466 549 ! … … 496 579 nbpoint_proc = nbpoint_glo 497 580 ENDIF 581 498 582 ! 499 583 ! On the slave processes we need to allocate the memory for the data on root_prc to be bcast … … 748 832 ! 749 833 mid_int = time_int(1) + (dt/2.0)/one_day 750 imin = MINLOC( ABS(time_central(1:slab_size) - mid_int), mask )834 imin = MINLOC( ABS(time_central(1:slab_size) - mid_int), mask(1:slab_size) ) 751 835 ! 752 836 ! Verify that this is a possible date … … 757 841 ! 758 842 ELSE 759 WRITE(*,*) "imin(1) = ", imin(1), (time_int_in(1) + (dt/2.0)/one_day)760 843 CALL forcing_printdate(time_int_in(1), "===> Start of target time interval.") 761 844 CALL forcing_printdate(time_int_in(2), "===> End of target time interval.") … … 823 906 mid_int = time_int(1) + (dt/2.0)/one_day 824 907 ! Locate that time on the time axis of the forcing. 825 imin = MINLOC( ABS(time_central(1:slab_size) - mid_int), mask )908 imin = MINLOC( ABS(time_central(1:slab_size) - mid_int), mask(1:slab_size) ) 826 909 ! 827 910 ! Determine which indices are to the left (slabind_a) and right (slabind_b) of the model time and will be used 828 911 ! for the linear interpolation. 829 912 ! 913 830 914 IF ( imin(1) > 1 .AND. imin(1) < slab_size ) THEN 831 915 ! … … 851 935 IF ( mid_int < time_central(slabind_a) ) THEN 852 936 IF ( time_int(2) < time_central(slabind_a) ) THEN 853 WRITE(*,*) "imin(1) = ", imin(1), (time_int_in(1) + (dt/2.0)/one_day)854 937 CALL forcing_printdate(time_int_in(1), "===> Start of target time interval.") 855 938 CALL forcing_printdate(time_int_in(2), "===> End of target time interval.") … … 869 952 IF ( mid_int > time_central(slabind_b) ) THEN 870 953 IF ( time_int(1) > time_central(slabind_b) ) THEN 871 WRITE(*,*) "imin(1) = ", imin(1), (time_int_in(1) + (dt/2.0)/one_day)872 954 CALL forcing_printdate(time_int_in(1), "===> Start of target time interval.") 873 955 CALL forcing_printdate(time_int_in(2), "===> End of target time interval.") … … 1027 1109 ! In principle 3 time steps can contribute to the time step closest to the center of the forcing interval 1028 1110 ! 1029 imin = MINLOC( ABS(time_central(1:slab_size)-(time_int(1)+time_int(2))/2.0), mask )1111 imin = MINLOC( ABS(time_central(1:slab_size)-(time_int(1)+time_int(2))/2.0), mask(1:slab_size) ) 1030 1112 tind(1) = MAX(imin(1)-1,1) 1031 1113 tind(2) = imin(1) … … 1216 1298 ! Locate the time step in the SLAB at hand 1217 1299 ! 1218 imin = MINLOC( ABS(time_cent(1:slab_size)-(time_int(1)+time_int(2))/2.0), mask )1300 imin = MINLOC( ABS(time_cent(1:slab_size)-(time_int(1)+time_int(2))/2.0), mask(1:slab_size) ) 1219 1301 ! 1220 1302 ! Compute all the angels we will encounter for the current forcing interval … … 1241 1323 julian_tmp = (time_int(1)+time_int(2))/2.0 1242 1324 split_time = julian_tmp+split*tlen/one_day 1243 tmin = MINLOC( ABS(time_cent(1:slab_size) - split_time), mask )1325 tmin = MINLOC( ABS(time_cent(1:slab_size) - split_time), mask(1:slab_size)) 1244 1326 DO WHILE ( tmin(1) .EQ. imin(1) .AND. split_time .LE. timebnd(slab_size,2) ) 1245 1327 split = split + 1 1246 1328 split_time = julian_tmp+split*tlen/one_day 1247 tmin = MINLOC( ABS(time_cent(1:slab_size) - split_time), mask )1329 tmin = MINLOC( ABS(time_cent(1:slab_size) - split_time), mask(1:slab_size)) 1248 1330 ENDDO 1249 1331 ! … … 1625 1707 ! 1626 1708 first_call_readslab = .FALSE. 1709 write(numout, *) "first_call_readslab in forcing_readslab_root" 1627 1710 ! 1628 1711 ELSE … … 1636 1719 ! 1637 1720 current_offset = position_slab(2)-2 1638 ! 1639 ENDIF 1721 write(numout, *) "first_call_readslab in forcing_readslab_root 22" 1722 ! 1723 ENDIF 1724 1640 1725 ! 1641 1726 ! Check that the slab size is not too large … … 1653 1738 inslabpos=1 1654 1739 WRITE(*,*) ">> Reading from global position ", start_globtime, "up to ", end_globtime 1740 write(numout,*) time_sourcefile 1655 1741 ! 1656 1742 DO if=MINVAL(time_sourcefile(start_globtime:end_globtime)),MAXVAL(time_sourcefile(start_globtime:end_globtime)) … … 1693 1779 CALL forcing_varforslab(if, "Tairmin", nctstart, nctcount, inslabpos, tairmin, cellmethod) 1694 1780 ENDIF 1781 1782 1695 1783 CALL forcing_varforslab(if, "Tair", nctstart, nctcount, inslabpos, tair, cellmethod) 1696 1784 CALL forcing_attributetimeaxe(cellmethod, timeid_tair) … … 1796 1884 ! 1797 1885 IF ( position_slab(2)-position_slab(1) .GT. slab_size ) THEN 1798 WRITE(*,*) "Postition_slab =", position_slab1799 WRITE(*,*) "Interval read : ", position_slab(2)-position_slab(1)1800 WRITE(*,*) "Time start and end : ", time(1,1), time(slab_size,1)1801 1886 DO it =1,nbtax 1802 1887 WRITE(*,*) "Checking time_tmp on idex : ", it … … 1806 1891 WRITE(*,*) "Interval read : ", imax(1)-imin(1)+1 1807 1892 ENDDO 1808 WRITE(*,*) "current_offset, slab_size =", current_offset, slab_size1809 1893 CALL ipslerr (3,'forcing_readslab_root',"The time slab read does not fit the number of variables read.",& 1810 1894 & "Could there be an error in the time axis ?"," ") … … 2411 2495 ! 2412 2496 ENDDO 2497 IF ( iim_glo == 0 .AND. jjm_glo == 0 ) THEN 2498 CALL ipslerr (3,'forcing_getglogrid',"Did not recognize any dimensions in : ", filename(iff), " ") 2499 ENDIF 2413 2500 ENDDO 2501 2414 2502 ! 2415 2503 ! 3.0 Read the spatial coordinate variables found in the first file. … … 2575 2663 CALL forcing_contfrac2d(force_id(1), testvar_id, contfrac_id, testvar2d, contfrac2d, & 2576 2664 & testvar_missing, contfrac_missing, nbland_glo) 2665 2666 2577 2667 ! 2578 2668 ! We have found a variable on which we can count the number of land points. We can build … … 2581 2671 IF ( landonly ) THEN 2582 2672 nbpoint_glo = nbland_glo 2673 2674 2583 2675 IF ( .NOT. ALLOCATED(lindex_glo)) ALLOCATE(lindex_glo(nbpoint_glo)) 2584 2676 IF ( .NOT. ALLOCATED(contfrac_glo)) ALLOCATE(contfrac_glo(nbpoint_glo)) 2585 2677 IF ( .NOT. ALLOCATED(testvar)) ALLOCATE(testvar(nbpoint_glo)) 2678 2679 2586 2680 IF ( contfrac_id > 0 ) THEN 2587 2681 CALL forcing_buildindex(contfrac2d, contfrac_missing, landonly, lindex_glo, contfrac_glo) 2588 2682 CALL forcing_reindex(iim_glo, jjm_glo, testvar2d, nbland_glo, testvar, lindex_glo) 2683 2684 2589 2685 ELSE 2590 2686 CALL forcing_buildindex(testvar2d, testvar_missing, landonly, lindex_glo, testvar) 2591 2687 contfrac_glo(:) = 1.0 2688 2592 2689 ENDIF 2593 2690 ELSE … … 2614 2711 dump_mask = closefile 2615 2712 CALL forcing_checkindex(dump_mask, testvarname, testvar) 2713 2616 2714 ! 2617 2715 ! … … 2627 2725 jjm_tmp = jjm_glo 2628 2726 nbpoint_tmp = nbpoint_glo 2727 2629 2728 ! 2630 2729 ! Clean up ! … … 2668 2767 ! 2669 2768 INTEGER(i_std) :: i,j,k 2670 ! 2671 k=0 2672 DO i=1,iim_glo 2673 DO j=1,jjm_glo 2674 IF ( landonly ) THEN 2675 IF ( var2d(i,j) /= var_missing ) THEN 2769 2770 IF ( MAXVAL(var2d) >= var_missing ) THEN 2771 ! Case when we have missing values in the vard2d 2772 k=0 2773 DO i=1,iim_glo 2774 DO j=1,jjm_glo 2775 IF ( landonly ) THEN 2776 IF ( var2d(i,j) /= var_missing .AND. var2d(i,j) > 0.0 ) THEN 2777 k = k + 1 2778 lindex(k) = (j-1)*iim_glo+i 2779 var(k) = var2d(i,j) 2780 ENDIF 2781 ELSE 2782 ! When we take all point, no test is performed. 2676 2783 k = k + 1 2677 2784 lindex(k) = (j-1)*iim_glo+i 2678 2785 var(k) = var2d(i,j) 2679 2786 ENDIF 2680 ELSE 2681 ! When we take all point, no test is performed. 2682 k = k + 1 2683 lindex(k) = (j-1)*iim_glo+i 2684 var(k) = var2d(i,j) 2685 ENDIF 2787 ENDDO 2686 2788 ENDDO 2687 ENDDO 2789 ELSE 2790 ! We suppose that this is land fraction variable 2791 k=0 2792 DO i=1,iim_glo 2793 DO j=1,jjm_glo 2794 IF ( landonly ) THEN 2795 IF ( var2d(i,j) > 0.0 ) THEN 2796 k = k + 1 2797 lindex(k) = (j-1)*iim_glo+i 2798 var(k) = var2d(i,j) 2799 ENDIF 2800 ELSE 2801 ! When we take all point, no test is performed. 2802 k = k + 1 2803 lindex(k) = (j-1)*iim_glo+i 2804 var(k) = var2d(i,j) 2805 ENDIF 2806 ENDDO 2807 ENDDO 2808 ENDIF 2809 ! 2688 2810 ! 2689 2811 END SUBROUTINE forcing_buildindex … … 2721 2843 ! First determine the contfrac variable 2722 2844 ! 2845 2723 2846 IF ( contfrac_id > 0 ) THEN 2724 2847 iret = NF90_INQUIRE_VARIABLE(ifile, contfrac_id, ndims=it) … … 2822 2945 "We do not know how to handle this.", " ") 2823 2946 ENDIF 2824 ! 2825 ! Count the number of land points. 2826 ! 2827 DO i=1,iim_glo 2828 DO j=1,jjm_glo 2829 IF ( contfrac(i,j) /= contfrac_missing ) THEN 2830 nbland = nbland + 1 2831 ENDIF 2947 2948 IF ( MAXVAL(contfrac) >= contfrac_missing ) THEN 2949 ! We have missing values in contfrac and we use it to count number of land points 2950 DO i=1,iim_glo 2951 DO j=1,jjm_glo 2952 IF ( contfrac(i,j) /= contfrac_missing .AND. contfrac(i,j) > 0.0 ) THEN 2953 nbland = nbland + 1 2954 ENDIF 2955 ENDDO 2832 2956 ENDDO 2833 ENDDO 2834 ! 2957 2958 ELSE 2959 ! Then ocean is fully contfrc=0 ! 2960 DO i=1,iim_glo 2961 DO j=1,jjm_glo 2962 IF ( contfrac(i,j) > 0.0 ) THEN 2963 nbland = nbland + 1 2964 ENDIF 2965 ENDDO 2966 ENDDO 2967 2968 ENDIF 2969 2835 2970 ! If we did not find any land points on the map (i.e. iim_glo > 1 and jjm_glo > 1) then we 2836 2971 ! look for fractions larger then 0. … … 2845 2980 ENDDO 2846 2981 ENDIF 2847 !2982 2848 2983 ! Did we get a result ? 2849 2984 ! … … 2983 3118 CALL forcing_reindex(nbpoint_glo, testvar, nbpoint_glo, testvar_reind, reindex_glo) 2984 3119 ! 3120 2985 3121 CALL forcing_writetestvar("forcing_mask_glo.nc", iim_glo, jjm_glo, nbpoint_glo, & 2986 3122 & lon_glo(:,1), lat_glo(1,:), lindex_glo, mask_glo, & … … 3248 3384 ! 3249 3385 nbpoint_loc = SUM(mask_loc) 3386 3387 3250 3388 IF ( .NOT. zoom_forcing .AND. nbpoint_loc .NE. nbpoint_glo) THEN 3251 3389 WRITE(*,*) "We have not zoomed into the forcing file still we get a number of" … … 3945 4083 ! 3946 4084 DO it=1,nbtime_perfile(iff) 3947 time_infiles(tstart+it) = date0_file(iff,tcnt) + time_read(it)*convtosec(iff)/one_day 4085 !!time_infiles(tstart+it) = date0_file(iff,tcnt) + time_read(it)*convtosec(iff)/one_day 4086 IF ( convtosec(iff) < one_day ) THEN 4087 time_infiles(tstart+it) = date0_file(iff,tcnt) + time_read(it)*convtosec(iff)/one_day 4088 ELSE 4089 ! In the case of daily forcing the start time has to be 00UTC in Julian days. 4090 time_infiles(tstart+it) = date0_file(iff,tcnt) + INT(time_read(it)) 4091 ENDIF 3948 4092 ENDDO 3949 4093 if ( check ) WRITE(*,*) "File ", iff, "goes from ", time_infiles(tstart+1), " to ", & … … 4247 4391 ! Zoom into the data and put it in the right place in the slab of data. 4248 4392 ! 4393 4249 4394 CALL forcing_reindex(iim_glo, jjm_glo, timecount, tmp_slab2d, nbpoint_loc, slab_size, data, inslabpos, reindex2d_loc) 4395 4250 4396 ENDIF 4251 4397 ELSE -
branches/ORCHIDEE_2_2/ORCHIDEE/src_driver/orchideedriver.f90
r7261 r7262 50 50 USE ioipslctrl 51 51 USE xios_orchidee 52 52 53 ! 53 54 !- … … 317 318 IF ( is_root_prc) THEN 318 319 CALL globgrd_getdomsz(gridfilename, iim_glo, jjm_glo, nbindex_g, model_guess, file_id, forfilename, zoom_lon, zoom_lat) 320 write(numout,*) "nbindex_g after calling globgrd_getdomsz in orchideedriver", nbindex_g 319 321 nbseg = 4 320 322 ENDIF … … 342 344 & kindex_g, contfrac_glo, calendar) 343 345 ENDIF 346 344 347 ! 345 348 CALL bcast(lon_glo) … … 369 372 ENDDO 370 373 ! 374 371 375 WRITE(*,*) "Rank", mpi_rank, " Before parallel region All land points : ", nbindex_g 372 376 WRITE(*,*) "Rank", mpi_rank, " from ", iim_glo, " point in Lon. and ", jjm_glo, "in Lat." … … 382 386 !- 383 387 CALL grid_set_glo(iim_glo, jjm_glo, nbindex_g) 388 389 384 390 CALL grid_allocate_glo(nbseg) 385 391 ! Copy the list of indexes of land points into index_g used by ORCHIDEE and then broacast to all … … 477 483 !- 478 484 CALL forcing_integration_time(date0, dt, nbdt) 485 write(numout, *) "orchideedriver date0", date0, dt, nbdt 479 486 ! 480 487 !- … … 558 565 ! 559 566 CALL ioipslctrl_restini(itau, date0, dt, rest_id, rest_id_stom, itau_offset, date0_shifted) 560 WRITE(numout,*) "itau_offset : ", itau_offset, date0, date0_shifted561 WRITE(numout,*) "itau_offset diff = ", date0_shifted, date0, date0_shifted-date0562 567 ! 563 568 ! To ensure that itau starts with 0 at date0 for the restart, we have to set an off-set to achieve this. … … 574 579 date0, year_end, month_end, day_end, julian_diff, & 575 580 lon, lat, znt) 576 577 581 CALL sechiba_xios_initialize 578 582 … … 599 603 timestep_interval(1) = julian_start 600 604 timestep_interval(2) = julian_end 601 julian = julian_end 605 julian = (julian_start + julian_end) /2.0 !julian_end 606 602 607 ! 603 608 ! Get the forcing data … … 605 610 CALL forcing_getvalues(timestep_interval, dt, zlev_tq, zlev_uv, temp_air, qair, & 606 611 & precip_rain, precip_snow, swdown, lwdown, sinang, u, v, pb) 612 607 613 !- 608 614 !
Note: See TracChangeset
for help on using the changeset viewer.