Changeset 7901 for branches/ORCHIDEE_2_2/ORCHIDEE
- Timestamp:
- 2023-03-02T15:18:40+01:00 (16 months ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/ORCHIDEE_2_2/ORCHIDEE/src_driver/forcing_tools.f90
r7796 r7901 99 99 INTEGER(i_std), SAVE :: nb_forcefile=0 100 100 CHARACTER(LEN=100), SAVE, ALLOCATABLE, DIMENSION(:) :: forfilename 101 INTEGER(i_std), SAVE, ALLOCATABLE, DIMENSION(:) :: force_id, id_unlim 101 INTEGER(i_std), SAVE, ALLOCATABLE, DIMENSION(:), public :: force_id 102 INTEGER(i_std), SAVE, ALLOCATABLE, DIMENSION(:) :: id_unlim 102 103 INTEGER(i_std), SAVE, ALLOCATABLE, DIMENSION(:) :: nb_atts, ndims, nvars 103 104 REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:) :: convtosec … … 148 149 REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:) :: tair_slab, qair_slab 149 150 REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:) :: tairmax_slab, tairmin_slab 151 REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:) :: hurs_slab 150 152 REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:) :: time_tair, time_qair 151 153 REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:) :: timebnd_tair, timebnd_qair … … 732 734 CALL forcingdaily_gensubd(time_int, dt, iim_loc, jjm_loc, lon_loc, lat_loc, glolindex_proc, & 733 735 & nbpoint_proc, slab_size, time_tair, ztq_slab, zuv_slab, tair_slab, & 734 & tairmin_slab, tairmax_slab, qair_slab, rainf_slab, snowf_slab, &736 & tairmin_slab, tairmax_slab, qair_slab, hurs_slab, rainf_slab, snowf_slab, & 735 737 & swdown_slab, lwdown_slab, u_slab, v_slab, ps_slab) 736 738 CALL forcingdaily_getvalues(time_int, dt, zlev_tq, zlev_uv, tair, qair, rainf, snowf, & … … 1432 1434 REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: tair_full, qair_full 1433 1435 REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: tairmin_full, tairmax_full 1436 REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: hurs_full 1434 1437 REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: rainf_full, snowf_full 1435 1438 REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: swdown_full, lwdown_full … … 1450 1453 IF ( .NOT. ALLOCATED(tairmax_slab) ) ALLOCATE(tairmax_slab(nbpoint_proc,slab_size)) 1451 1454 IF ( .NOT. ALLOCATED(tairmin_slab) ) ALLOCATE(tairmin_slab(nbpoint_proc,slab_size)) 1455 IF ( .NOT. ALLOCATED(hurs_slab) ) ALLOCATE(hurs_slab(nbpoint_proc,slab_size)) 1452 1456 ENDIF 1453 1457 ! … … 1506 1510 ALLOCATE(tairmax_full(nbpoint_loc,slab_size)) 1507 1511 ALLOCATE(tairmin_full(nbpoint_loc,slab_size)) 1512 ALLOCATE(hurs_full(nbpoint_loc,slab_size)) 1508 1513 ELSE 1509 1514 ALLOCATE(tairmax_full(1,1)) 1510 1515 ALLOCATE(tairmin_full(1,1)) 1516 ALLOCATE(hurs_full(1,1)) 1511 1517 ENDIF 1512 1518 ALLOCATE(qair_full(nbpoint_loc,slab_size)) … … 1523 1529 CALL forcing_readslab_root(time_int, first_call_readslab, & 1524 1530 & tair_full, tairmax_full, tairmin_full, time_tair, timebnd_tair, & 1525 & qair_full, time_qair, timebnd_qair, &1531 & qair_full, hurs_full, time_qair, timebnd_qair, & 1526 1532 & rainf_full, snowf_full, time_precip, timebnd_precip, & 1527 1533 & swdown_full, time_swdown, timebnd_swdown, & … … 1579 1585 CALL scatter(tairmax_full, tairmax_slab) 1580 1586 CALL scatter(tairmin_full, tairmin_slab) 1587 CALL scatter(hurs_full, hurs_slab) 1581 1588 ENDIF 1582 1589 CALL scatter(qair_full, qair_slab) … … 1595 1602 tairmax_slab(:,:) = tairmax_full(:,:) 1596 1603 tairmin_slab(:,:) = tairmin_full(:,:) 1604 hurs_slab(:,:) = hurs_full(:,:) 1597 1605 ENDIF 1598 1606 qair_slab(:,:) = qair_full(:,:) … … 1633 1641 IF ( ALLOCATED(tairmax_full) ) DEALLOCATE(tairmax_full) 1634 1642 IF ( ALLOCATED(tairmin_full) ) DEALLOCATE(tairmin_full) 1643 IF ( ALLOCATED(hurs_full) ) DEALLOCATE(hurs_full) 1635 1644 IF ( ALLOCATED(qair_full) ) DEALLOCATE(qair_full) 1636 1645 IF ( ALLOCATED(rainf_full) ) DEALLOCATE(rainf_full) … … 1660 1669 SUBROUTINE forcing_readslab_root(time_int, first_call_readslab, & 1661 1670 & tair, tairmax, tairmin, t_tair, tbnd_tair, & 1662 & qair, t_qair, tbnd_qair, &1671 & qair, hurs, t_qair, tbnd_qair, & 1663 1672 & rainf, snowf, t_prec, tbnd_prec, & 1664 1673 & swdown, t_swdown, tbnd_swdown, & … … 1678 1687 REAL(r_std), INTENT(out) :: tbnd_tair(:,:) 1679 1688 ! 1680 REAL(r_std), INTENT(out) :: qair(:,:) 1689 REAL(r_std), INTENT(out) :: qair(:,:), hurs(:,:) 1681 1690 REAL(r_std), INTENT(out) :: t_qair(:) 1682 1691 REAL(r_std), INTENT(out) :: tbnd_qair(:,:) … … 1805 1814 ! 1806 1815 ! 2.1 Deal with air temperature and humidity as the fist and basic case 1807 ! 1816 ! hurs: relative humidity 1817 ! qair: specific humidity 1818 ! 1819 IF ( ExistVariable(if, "Tair") ) THEN 1820 CALL forcing_varforslab(if, "Tair", nctstart, nctcount, inslabpos, tair, cellmethod) 1821 CALL forcing_attributetimeaxe(cellmethod, timeid_tair) 1822 ELSE IF ( ( forcing_tstep_ave >= one_day/3.0) .AND. ( ExistVariable(if, "Tmax"))) THEN 1823 CALL forcing_varforslab(if, "Tmax", nctstart, nctcount, inslabpos, tairmax, cellmethod) 1824 CALL forcing_varforslab(if, "Tmin", nctstart, nctcount, inslabpos, tairmin, cellmethod) 1825 CALL forcing_attributetimeaxe(cellmethod, timeid_tair) 1826 tair(:,:) = tairmax(:,:) 1827 ELSE 1828 CALL ipslerr(3, 'forcing_readslab_root','We do not have Tair or Tmax in the file but we need it',& 1829 & 'because the timestep of the forcing is sub-diurnal','') 1830 ENDIF 1831 1808 1832 ! 1809 ! 1810 IF ( forcing_tstep_ave >= one_day/3.0) THEN 1811 CALL forcing_varforslab(if, "Tairmax", nctstart, nctcount, inslabpos, tairmax, cellmethod) 1812 CALL forcing_varforslab(if, "Tairmin", nctstart, nctcount, inslabpos, tairmin, cellmethod) 1833 ! 2.2 Deal with rainfall and snowfall. 1834 ! 1835 IF ( ExistVariable(if, "Rainf") ) THEN 1836 CALL forcing_varforslab(if, "Rainf", nctstart, nctcount, inslabpos, rainf, cellmethod) 1837 CALL forcing_attributetimeaxe(cellmethod, timeid_precip) 1838 1839 ELSE IF ( (forcing_tstep_ave >= one_day/3.0)) THEN 1840 CALL forcing_varforslab(if, "precip", nctstart, nctcount, inslabpos, rainf, cellmethod) 1841 CALL forcing_attributetimeaxe(cellmethod, timeid_precip) 1813 1842 ENDIF 1814 1815 1816 CALL forcing_varforslab(if, "Tair", nctstart, nctcount, inslabpos, tair, cellmethod) 1817 CALL forcing_attributetimeaxe(cellmethod, timeid_tair) 1818 ! 1819 CALL forcing_varforslab(if, "Qair", nctstart, nctcount, inslabpos, qair, cellmethod) 1820 CALL forcing_attributetimeaxe(cellmethod, timeid_qair) 1821 ! 1822 ! 2.2 Deal with rainfall and snowfall. 1823 ! 1824 CALL forcing_varforslab(if, "Rainf", nctstart, nctcount, inslabpos, rainf, cellmethod) 1825 CALL forcing_attributetimeaxe(cellmethod, timeid_precip) 1826 ! 1827 CALL forcing_varforslab(if, "Snowf", nctstart, nctcount, inslabpos, snowf, cellmethod) 1828 CALL forcing_attributetimeaxe(cellmethod, timeid_tmp) 1829 IF ( timeid_precip .NE. timeid_tmp) THEN 1830 CALL ipslerr(3, 'forcing_readslab_root','Rainf and Snwof have different time axes.', & 1831 & 'Please check the forcing file to ensure both variable have the same cell_method.','') 1843 ! 1844 IF ( ExistVariable(if, "Snowf")) THEN 1845 CALL forcing_varforslab(if, "Snowf", nctstart, nctcount, inslabpos, snowf, cellmethod) 1846 CALL forcing_attributetimeaxe(cellmethod, timeid_tmp) 1847 IF ( timeid_precip .NE. timeid_tmp) THEN 1848 CALL ipslerr(3, 'forcing_readslab_root','Rainf and Snwof have different time axes.', & 1849 & 'Please check the forcing file to ensure both variable have the same cell_method.','') 1850 ENDIF 1851 1852 ELSE IF ( (forcing_tstep_ave >= one_day/3.0) )THEN 1853 snowf(:,:) = rainf(:,:) 1854 WHERE (tair(:,:)>=273.15) 1855 snowf(:,:) = 0.0 1856 ELSEWHERE (tair(:,:)<273.15) 1857 rainf(:,:) = 0.0 1858 END WHERE 1832 1859 ENDIF 1860 ! 1861 ! 1862 IF ( ExistVariable(if, "Qair") ) THEN 1863 CALL forcing_varforslab(if, "Qair", nctstart, nctcount, inslabpos, qair, cellmethod) 1864 CALL forcing_attributetimeaxe(cellmethod, timeid_qair) 1865 ELSE IF ( ExistVariable(if, "hurs") ) THEN 1866 CALL forcing_varforslab(if, "hurs", nctstart, nctcount, inslabpos, hurs, cellmethod) 1867 CALL forcing_attributetimeaxe(cellmethod, timeid_qair) 1868 CALL ipslerr(3, 'forcing_readslab_root','hurs is read from forcing file', & 1869 & 'Please make sure that the conversion from hurs to specific humidity is correct before continue simulation.','') 1870 ELSE 1871 CALL ipslerr(3, 'forcing_readslab_root','We do not have Qair or hurs in the file but we need one of them',& 1872 & 'because the timestep of the forcing is sub-diurnal','') 1873 ENDIF 1874 ! 1833 1875 ! 1834 1876 ! … … 2447 2489 INTEGER(i_std) :: ik, i, j, iff, ndimsvar 2448 2490 ! Read a test variabe 2449 CHARACTER(len=8) :: testvarname ='Tair'2491 CHARACTER(len=8) :: testvarname 2450 2492 INTEGER(i_std) :: testvar_id, contfrac_id 2451 2493 REAL(r_std) :: testvar_missing, contfrac_missing … … 2531 2573 ENDIF 2532 2574 ENDDO 2533 2575 ! 2576 iret = NF90_INQ_VARID(force_id(1), 'Tair', iv) 2577 IF (iret == NF90_NOERR) THEN 2578 testvarname = 'Tair' 2579 ELSE 2580 iret = NF90_INQ_VARID(force_id(1), 'Tmax', iv) 2581 IF (iret == NF90_NOERR) THEN 2582 testvarname = 'Tmax' 2583 ELSE 2584 CALL ipslerr (3,'forcing_getglogrid',"Could not find variable Tair or Tmax in file."," "," ") 2585 ENDIF 2586 ENDIF 2534 2587 ! 2535 2588 ! 3.0 Read the spatial coordinate variables found in the first file. … … 3292 3345 INTEGER(i_std) :: iindex_init, jindex_init, iindex_end, jindex_end, i_orig, j_orig 3293 3346 ! 3294 INTEGER(i_std) :: iret, force_id, iv 3347 INTEGER(i_std) :: iret, force_id, iv, ierr 3295 3348 INTEGER(i_std), DIMENSION(1) :: imin, jmin 3296 3349 INTEGER(i_std), DIMENSION(2) :: start, count … … 3300 3353 INTEGER(i_std), ALLOCATABLE, DIMENSION(:) :: index_glotoloc 3301 3354 REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: lalo 3302 CHARACTER(LEN=8) :: testvarname ="Tair"3355 CHARACTER(LEN=8) :: testvarname 3303 3356 ! 3304 3357 ! 0.0 Verify we are on the root processor … … 3328 3381 ENDDO 3329 3382 ENDDO 3383 ENDIF 3384 !! define dx and dy for regular grids 3385 IF ( model_guess .EQ. 'regular' ) THEN 3386 dx=ABS(lon_glo(2,1)-lon_glo(1,1)) 3387 dy=ABS(lat_glo(1,1)-lat_glo(1,2)) 3330 3388 ENDIF 3331 3389 ! … … 3577 3635 ! 3578 3636 DO j=1,jjm_loc 3579 dx = zero3580 DO i=1,iim_loc-13581 dx = dx+ABS(lon_loc(i,j)-lon_loc(i+1,j))3582 ENDDO3583 dx = dx/(iim_loc-1)3584 3637 DO i=1,iim_loc 3585 3638 corners_loc(i,j,1,1) = lon_loc(i,j)-dx/2.0 … … 3593 3646 ! 3594 3647 DO i=1,iim_loc 3595 dy = zero3596 DO j=1,jjm_loc-13597 dy = dy + ABS(lat_loc(i,j)-lat_loc(i,j+1))3598 ENDDO3599 dy = dy/(jjm_loc-1)3600 3648 DO j=1,jjm_loc 3601 3649 corners_loc(i,j,1,2) = lat_loc(i,j)+dy/2.0 … … 3631 3679 ALLOCATE(readvar(ncdfcount), readvar2d(iim_glo,jjm_glo), zoomedvar(nbpoint_loc)) 3632 3680 ! 3633 iret = NF90_INQ_VARID(force_id, TRIM(testvarname), iv) 3634 IF (iret /= NF90_NOERR) THEN 3635 CALL ipslerr (3,'forcing_zoomgrid',"Could not find variable Tair in file."," "," ") 3636 ENDIF 3637 3681 ! 3682 iret = NF90_INQ_VARID(force_id, 'Tair', iv) 3683 IF (iret == NF90_NOERR) THEN 3684 testvarname = 'Tair' 3685 ELSE 3686 iret = NF90_INQ_VARID(force_id, 'Tmax', iv) 3687 IF (iret == NF90_NOERR) THEN 3688 testvarname = 'Tmax' 3689 ELSE 3690 CALL ipslerr (3,'forcing_zoomgrid',"Could not find variable Tair or Tmax in file."," "," ") 3691 ENDIF 3692 ENDIF 3693 ! 3638 3694 IF ( compressed ) THEN 3639 3695 ! … … 3669 3725 & lon_loc(:,1), lat_loc(1,:), lindex_loc, mask_loc, & 3670 3726 & TRIM(testvarname), zoomedvar) 3727 ierr = NF90_CLOSE(force_id) 3671 3728 ! 3672 3729 ENDIF … … 4089 4146 ! 4090 4147 ! Go through all files in the list in order to get the total number of time steps we have 4091 ! in the nbfiles files to be read 4148 ! in the nbfiles files to be read. nb_forcing_steps: three full years of forcing time steps 4092 4149 ! 4093 4150 nb_forcing_steps = 0 … … 4370 4427 END SUBROUTINE forcing_time 4371 4428 4429 4430 !! -------------------------------------------------------------------- 4431 !! FUNCTION ExistVariable(): 4432 !! This function tests if the variable exists in the file. 4433 !! -------------------------------------------------------------------- 4434 FUNCTION ExistVariable(fileindex, varname) RESULT(exists) 4435 IMPLICIT NONE 4436 INTEGER(i_std), INTENT(in) :: fileindex 4437 CHARACTER(LEN=*), INTENT(in) :: varname 4438 LOGICAL :: exists 4439 ! 4440 CHARACTER(LEN=80) :: name 4441 INTEGER(i_std) :: iret, iv 4442 ! 4443 exists=.FALSE. 4444 ! 4445 DO iv=1,nvars(fileindex) 4446 ! 4447 iret = NF90_INQUIRE_VARIABLE(force_id(fileindex), iv, name=name) 4448 ! 4449 IF ( INDEX(name, varname) > 0 ) THEN 4450 exists = .TRUE. 4451 ENDIF 4452 ENDDO 4453 4454 END FUNCTION ExistVariable 4455 4372 4456 !! ============================================================================================================================= 4373 4457 !! SUBROUTINE: forcing_varforslab
Note: See TracChangeset
for help on using the changeset viewer.
