| 1 |
jscott |
1.1 |
|
| 2 |
|
|
#include "ctrparam.h" |
| 3 |
|
|
|
| 4 |
|
|
! ========================================================== |
| 5 |
|
|
! |
| 6 |
|
|
! TRVDATA.F: THIS SUBROUTINE CALCULATS TRANSIENT VDATA |
| 7 |
|
|
! |
| 8 |
|
|
! ========================================================== |
| 9 |
|
|
|
| 10 |
|
|
SUBROUTINE TRVDATA |
| 11 |
|
|
C**** 1502. |
| 12 |
|
|
C**** 1505. |
| 13 |
|
|
|
| 14 |
|
|
|
| 15 |
|
|
#include "ODIFF.COM" |
| 16 |
|
|
#include "BD2G04.COM" |
| 17 |
|
|
#include "RADCOM.COM" |
| 18 |
|
|
#include "run.COM" |
| 19 |
|
|
|
| 20 |
|
|
|
| 21 |
|
|
COMMON/SPEC2/KM,KINC,COEK,C3LAND(IO0,JM0),C3OICE(IO0,JM0) 1506.1 |
| 22 |
|
|
* ,C3LICE(IO0,JM0),WMGE(IO0,JM0),TSSFC(IM0,JM0,4) 1506.2 |
| 23 |
|
|
common/veg/TRVEG,IYVEG |
| 24 |
|
|
logical TRVEG |
| 25 |
|
|
dimension VMASK(JM0) |
| 26 |
|
|
JM=JM0 1531. |
| 27 |
|
|
IM=IM0 |
| 28 |
|
|
IO=IO0 1532.5 |
| 29 |
|
|
LM=LM0 1533. |
| 30 |
|
|
C**** READ IN EARTH RATIOS FOR THE 8 VEGETATION TYPES AND THE VADATA : 1816. |
| 31 |
|
|
C VADATA(TYPE,SEASON,1)=GROUND ALBEDO FOR A GIVEN TYPE AND SEASON 1817. |
| 32 |
|
|
C 1 2 3 4 5 6 7 8 1818. |
| 33 |
|
|
C DESRT TNDRA GRASS SHRUB TREES DECID EVERG RAINF 1819. |
| 34 |
|
|
C SPRN 0.35, 0.12, 0.16, 0.16, 0.14, 0.18, 0.12, 0.11, 1820. |
| 35 |
|
|
C SUMR 0.35, 0.12, 0.20, 0.18, 0.14, 0.12, 0.12, 0.11, 1821. |
| 36 |
|
|
C FALL 0.35, 0.17, 0.20, 0.25, 0.17, 0.15, 0.15, 0.11, 1822. |
| 37 |
|
|
C WNTR 0.35, 0.15, 0.18, 0.20, 0.12, 0.12, 0.11, 0.11/ 1823. |
| 38 |
|
|
C 1824. |
| 39 |
|
|
C VADATA(TYPE,SEASON,2)=RATIO OF NEAR IR ALBEDO TO VIS ALBEDO FOR...1825. |
| 40 |
|
|
C 1 2 3 4 5 6 7 8 1826. |
| 41 |
|
|
C DESRT TNDRA GRASS SHRUB TREES DECID EVERG RAINF 1827. |
| 42 |
|
|
C SPRN 1.0, 3.0, 3.0, 3.0, 3.0, 3.0, 3.0, 3.0, 1828. |
| 43 |
|
|
C SUMR 1.0, 3.3, 3.5, 3.0, 3.3, 4.0, 3.0, 3.0, 1829. |
| 44 |
|
|
C FALL 1.0, 3.5, 4.0, 3.0, 3.5, 5.0, 3.0, 3.0, 1830. |
| 45 |
|
|
C WNTR 1.0, 3.2, 3.5, 3.0, 3.2, 4.0, 3.0, 3.0/ 1831. |
| 46 |
|
|
C 1832. |
| 47 |
|
|
C VADATA(TYPE,1,3)=MASKING DEPTH FOR A GIVEN TYPE 1833. |
| 48 |
|
|
C 1834. |
| 49 |
|
|
C 1 2 3 4 5 6 7 8 1835. |
| 50 |
|
|
C DESRT TNDRA GRASS SHRUB TREES DECID EVERG RAINF 1836. |
| 51 |
|
|
C 10., 20., 20., 50., 200., 500., 1000., 2500., 1837. |
| 52 |
|
|
C 1838. |
| 53 |
|
|
C VADATA(TYPE,1+K,3)=WATER FIELD CAPACITY FOR K-TH GROUND LAYER 1839. |
| 54 |
|
|
C 1840. |
| 55 |
|
|
C 1 10., 30., 30., 30., 30., 30., 30., 200., 1841. |
| 56 |
|
|
C 2 10., 200., 200., 300., 300., 450., 450., 450., 1842. |
| 57 |
|
|
C (3) 0., 0., 0., 0., 0., 0., 0., 0./ 1843. |
| 58 |
|
|
C 1844. |
| 59 |
|
|
READ (523) IYVEG |
| 60 |
|
|
764 READ (523) (((VDATA(I,J,K),I=1,IO),J=1,JM),K=1,8) |
| 61 |
|
|
print *,' From trvdata iyveg=',iyveg |
| 62 |
|
|
c print *,'VADATA' |
| 63 |
|
|
c do k=1,3 |
| 64 |
|
|
c print *,' K=',k |
| 65 |
|
|
c print '(8f7.2)',((VADATA(I,J,K),I=1,8),J=1,4) |
| 66 |
|
|
c enddo |
| 67 |
|
|
C**** MODIFY THE VADATA IF DESIRED 1847. |
| 68 |
|
|
C NO MODIFICATIONS 1848. |
| 69 |
|
|
C**** COMPUTE WATER FIELD CAPACITIES FOR GROUND LAYERS 1 AND 2 1849. |
| 70 |
|
|
IOFF=0 1849.1 |
| 71 |
|
|
IF(VADATA(4,2,3).LT.100.) IOFF=1 1849.2 |
| 72 |
|
|
ERROR=.001 1849.3 |
| 73 |
|
|
DEFLT=24. 1850. |
| 74 |
|
|
DO 785 L=1,2 1851. |
| 75 |
|
|
DO 780 J=1,JM 1852. |
| 76 |
|
|
DO 780 I=1,IO 1853. |
| 77 |
|
|
WFCIJL=0. 1854. |
| 78 |
|
|
DO 770 K=1,8 1855. |
| 79 |
|
|
770 WFCIJL=WFCIJL+VDATA(I,J,K)*VADATA(K,L+IOFF,3) 1856. |
| 80 |
|
|
IF (WFCIJL.LT.1.) WFCIJL=DEFLT 1857. |
| 81 |
|
|
IF(ISTART.NE.2) GO TO 780 |
| 82 |
|
|
IF(GDATA(I,J,4*L+1)+GDATA(I,J,4*L+2).LE.WFCIJL) GO TO 780 1858. |
| 83 |
|
|
X=WFCIJL/(GDATA(I,J,4*L+1)+GDATA(I,J,4*L+2)+1.E-3) 1859. |
| 84 |
|
|
GDATA(I,J,4*L+1)=GDATA(I,J,4*L+1)*X 1860. |
| 85 |
|
|
GDATA(I,J,4*L+2)=GDATA(I,J,4*L+2)*X 1861. |
| 86 |
|
|
780 VDATA(I,J,L+8)=WFCIJL 1862. |
| 87 |
|
|
DEFLT=60. 1863. |
| 88 |
|
|
785 CONTINUE 1864. |
| 89 |
|
|
DO 765 K=1,10 1864.5 |
| 90 |
|
|
DO 765 J=2,JMM1 1864.51 |
| 91 |
|
|
CONT1=0. 1864.52 |
| 92 |
|
|
SUM1=0. 1864.53 |
| 93 |
|
|
DO 766 I=1,IO 1864.54 |
| 94 |
|
|
PEARTH=C3LAND(I,J)-C3LICE(I,J) 1864.55 |
| 95 |
|
|
CONT1=CONT1+PEARTH 1864.56 |
| 96 |
|
|
766 SUM1=SUM1+PEARTH*VDATA(I,J,K) 1864.57 |
| 97 |
|
|
IF (CONT1.LE.0.) GO TO 765 1864.58 |
| 98 |
|
|
SUM1=SUM1/CONT1 1864.59 |
| 99 |
|
|
DO 767 I=1,IO 1864.6 |
| 100 |
|
|
767 VDATA(I,J,K)=SUM1 1864.61 |
| 101 |
|
|
765 CONTINUE 1864.62 |
| 102 |
|
|
c print *,' BEAR LAND' |
| 103 |
|
|
c print '(12f7.2,/,11f7.2)',(VDATA(1,j,1),j=1,JM) |
| 104 |
|
|
c print *,' TRVDATA' |
| 105 |
|
|
c print *,' WMAX1' |
| 106 |
|
|
c print '(12f7.2,/,11f7.2)',(VDATA(1,j,9),j=1,JM) |
| 107 |
|
|
c print *,' WMAX2' |
| 108 |
|
|
c print '(12f7.2,/,11f7.2)',(VDATA(1,j,10),j=1,JM) |
| 109 |
|
|
C ************* |
| 110 |
|
|
DO K=1,8 |
| 111 |
|
|
c VADATA(K,4,3)=0.1*VADATA(K,4,3) |
| 112 |
|
|
VADATA(K,4,3)=VADATA(K,3,3) |
| 113 |
|
|
ENDDO |
| 114 |
|
|
DO J=1,JM |
| 115 |
|
|
CONT1=0. |
| 116 |
|
|
SUM1=0. |
| 117 |
|
|
DO I=1,IO |
| 118 |
|
|
WFCIJL=0. |
| 119 |
|
|
PEARTH=C3LAND(I,J)-C3LICE(I,J) |
| 120 |
|
|
CONT1=CONT1+PEARTH |
| 121 |
|
|
SUM1=SUM1+PEARTH*WFCIJL |
| 122 |
|
|
DO K=1,8 |
| 123 |
|
|
WFCIJL=WFCIJL+VDATA(I,J,K)*VADATA(K,4,3) |
| 124 |
|
|
ENDDO ! K |
| 125 |
|
|
SUM1=SUM1+PEARTH*WFCIJL |
| 126 |
|
|
ENDDO ! I |
| 127 |
|
|
IF (CONT1.LE.0.) GO TO 865 |
| 128 |
|
|
SUM1=SUM1/CONT1 |
| 129 |
|
|
VMASK(J)=SUM1 |
| 130 |
|
|
865 CONTINUE |
| 131 |
|
|
ENDDO ! J |
| 132 |
|
|
c print *,' VMASK form NP to SP in meters of water' |
| 133 |
|
|
c print '(12f7.2,/11f7.2)',(VMASK(jm-j+1),j=1,JM) |
| 134 |
|
|
C ************ |
| 135 |
|
|
return |
| 136 |
|
|
END 1923. |
Parent Directory
| 
Revision Log
| 
Revision Graph