| 1 |
|
| 2 |
#include "ctrparam.h" |
| 3 |
|
| 4 |
! ========================================================== |
| 5 |
! |
| 6 |
! UTIL.F: Some utility functions for the climate model. |
| 7 |
! |
| 8 |
! ---------------------------------------------------------- |
| 9 |
! |
| 10 |
! Revision History: |
| 11 |
! |
| 12 |
! When Who What |
| 13 |
! ----- ---------- ------- |
| 14 |
! 080200 Chien Wang repack based on CliChem3 & M24x11, |
| 15 |
! and add cpp. |
| 16 |
! |
| 17 |
! ========================================================== |
| 18 |
|
| 19 |
C CMS SYSTEM ROUTINES EMULATION FOR IBM RS/6000 |
| 20 |
C |
| 21 |
SUBROUTINE CLOCKS(IHSC) |
| 22 |
C THIS VERSION OF CLOCKS RETURNS PROCESS TIME OF USER AND |
| 23 |
C SYSTEM TIME OF CHILD PROCESSES |
| 24 |
C NOTE: MCLOCK IS REALLY IN HUNDREDTHS OF A SECOND, NOT SIXTIETHS. |
| 25 |
CCC IHSC=-MCLOCK() |
| 26 |
logical first |
| 27 |
real *4 zero,a |
| 28 |
data first /.true./ |
| 29 |
if(first) then |
| 30 |
zero=0.0 |
| 31 |
a=secnds(zero) |
| 32 |
first=.false. |
| 33 |
end if |
| 34 |
IHSC=100*secnds(a) |
| 35 |
c IHSC=0. |
| 36 |
RETURN |
| 37 |
END |
| 38 |
FUNCTION THBAR (X,Y) |
| 39 |
REAL A,B,C,D,E,F,G,Q,AL |
| 40 |
CC DOUBLE PRECISION A,B,C,D,E,F,G,Q,AL |
| 41 |
DATA A,B,C,D,E,F,G/113.4977618974100,438.5012518098521, |
| 42 |
* 88.49964112645850,-11.50111432385882, |
| 43 |
* 30.00033943846368,299.9975118132485,299.9994728900967/ |
| 44 |
Q=X/Y |
| 45 |
AL=(A+Q*(B+Q*(C+Q*(D+Q))))/(E+Q*(F+G*Q)) |
| 46 |
THBAR=X*AL |
| 47 |
RETURN |
| 48 |
END |
| 49 |
! |
| 50 |
FUNCTION EXPBYK (X) |
| 51 |
EXPBYK=X**.286 |
| 52 |
RETURN |
| 53 |
END |
| 54 |
! |
| 55 |
FUNCTION EXPBYKOLD (X) |
| 56 |
C EXPBYK=X**.286 |
| 57 |
c DOUBLE PRECISION A(7),B(7),C(7),D(7),E(7),F(7),G(7),H(7) |
| 58 |
REAL A(7),B(7),C(7),D(7),E(7),F(7),G(7),H(7) |
| 59 |
c DOUBLE PRECISION TOP, BOT |
| 60 |
C |
| 61 |
DATA A(1) /.3910084705257427D12/ |
| 62 |
DATA B(1) /.1323236271112985D11/ |
| 63 |
DATA C(1) /.4866245535199495D8/ |
| 64 |
DATA D(1) /.2825751070482957D5/ |
| 65 |
DATA E(1) /.2021679763023094D12/ |
| 66 |
DATA F(1) /.3219813576002469D10/ |
| 67 |
DATA G(1) /.7026939414893149D7/ |
| 68 |
DATA H(1) /.2245905505347945D4/ |
| 69 |
CUT1 DC E'.272E3' |
| 70 |
DATA A(2) /.1527376839478999D10/ |
| 71 |
DATA B(2) /.2067556673365934D9/ |
| 72 |
DATA C(2) /.3041403459557123D7/ |
| 73 |
DATA D(2) /.7064377675658254D4/ |
| 74 |
DATA E(2) /.1173982318753656D10/ |
| 75 |
DATA F(2) /.7478937617614235D8/ |
| 76 |
DATA G(2) /.6528830353471617D6/ |
| 77 |
DATA H(2) /.8346812273642854D3/ |
| 78 |
CUT2 DC E'.68E2' |
| 79 |
DATA A(3) /.5966315773653637D7/ |
| 80 |
DATA B(3) /.3230557302541690D7/ |
| 81 |
DATA C(3) /.1900877162187466D6/ |
| 82 |
DATA D(3) /.1766094418795829D4/ |
| 83 |
DATA E(3) /.6817273980203066D7/ |
| 84 |
DATA F(3) /.1737197094305671D7/ |
| 85 |
DATA G(3) /.6066030070508742D5/ |
| 86 |
DATA H(3) /.3102057273820339D3/ |
| 87 |
CUT3 DC E'.17E2' |
| 88 |
DATA A(4) /.2330592097816283D5/ |
| 89 |
DATA B(4) /.5047745784578189D5/ |
| 90 |
DATA C(4) /.1188048226473864D5/ |
| 91 |
DATA D(4) /.4415236046666724D3/ |
| 92 |
DATA E(4) /.3958766989520573D5/ |
| 93 |
DATA F(4) /.4035136939373286D5/ |
| 94 |
DATA G(4) /.5636035678286606D4/ |
| 95 |
DATA H(4) /.1152866390241182D3/ |
| 96 |
CUT4 DC E'.425E1' |
| 97 |
DATA A(5) /.9103875388060500D2/ |
| 98 |
DATA B(5) /.7887102788893237D3/ |
| 99 |
DATA C(5) /.7425301414937417D3/ |
| 100 |
DATA D(5) /.1103809011715425D3/ |
| 101 |
DATA E(5) /.2298842049606823D3/ |
| 102 |
DATA F(5) /.9372759240517918D3/ |
| 103 |
DATA G(5) /.5236521711877195D3/ |
| 104 |
DATA H(5) /.4284578897126435D2/ |
| 105 |
CUT5 DC E'.10625E1' |
| 106 |
DATA A(6) /.3556201323540056D0/ |
| 107 |
DATA B(6) /.1232359810733637D2/ |
| 108 |
DATA C(6) /.4640813384330962D2/ |
| 109 |
DATA D(6) /.2759522529901992D2/ |
| 110 |
DATA E(6) /.1334929482333115D1/ |
| 111 |
DATA F(6) /.2177091313247190D2/ |
| 112 |
DATA G(6) /.4865327546221521D2/ |
| 113 |
DATA H(6) /.1592345521834502D2/ |
| 114 |
CUT6 DC E'.265625E0' |
| 115 |
DATA A(7) /.1389141141676475D-2/ |
| 116 |
DATA B(7) /.1925562204367069D0/ |
| 117 |
DATA C(7) /.2900508365211162D1/ |
| 118 |
DATA D(7) /.6898806323349460D1/ |
| 119 |
DATA E(7) /.7751888493733211D-2/ |
| 120 |
DATA F(7) /.5056917033590845D0/ |
| 121 |
DATA G(7) /.4520445715351951D1/ |
| 122 |
DATA H(7) /.5917884392240980D1/ |
| 123 |
C |
| 124 |
C |
| 125 |
IF(X.LT.272.) GO TO 10 |
| 126 |
K=1 |
| 127 |
GO TO 100 |
| 128 |
10 IF(X.LT.68.) GO TO 20 |
| 129 |
K=2 |
| 130 |
GO TO 100 |
| 131 |
20 IF(X.LT.17.) GO TO 30 |
| 132 |
K=3 |
| 133 |
GO TO 100 |
| 134 |
30 IF(X.LT.4.25) GO TO 40 |
| 135 |
K=4 |
| 136 |
GO TO 100 |
| 137 |
40 IF(X.LT.1.0625) GO TO 50 |
| 138 |
K=5 |
| 139 |
GO TO 100 |
| 140 |
50 IF(X.LT.0.265625) GO TO 60 |
| 141 |
K=6 |
| 142 |
GO TO 100 |
| 143 |
60 K=7 |
| 144 |
C |
| 145 |
100 CONTINUE |
| 146 |
IF(X.LT.272. .AND. X.GE.68.) K=2 |
| 147 |
IF(X.LT.68. .AND. X.GE.17.) K=3 |
| 148 |
IF(X.LT.17. .AND. X.GE.4.25) K=4 |
| 149 |
IF(X.LT.4.25 .AND. X.GE.1.0625) K=5 |
| 150 |
IF(X.LT.1.0625 .AND. X.GE.0.265625) K=6 |
| 151 |
IF(X.LT.0.265625) K=7 |
| 152 |
C |
| 153 |
TOP = X |
| 154 |
BOT = H(K) |
| 155 |
TOP = TOP + D(K) |
| 156 |
BOT = BOT * X |
| 157 |
TOP = TOP * X |
| 158 |
BOT = BOT + G(K) |
| 159 |
TOP = TOP + C(K) |
| 160 |
BOT = BOT * X |
| 161 |
TOP = TOP * X |
| 162 |
BOT = BOT + F(K) |
| 163 |
TOP = TOP + B(K) |
| 164 |
BOT = BOT * X |
| 165 |
TOP = TOP * X |
| 166 |
BOT = BOT + E(K) |
| 167 |
TOP = TOP + A(K) |
| 168 |
C |
| 169 |
TOP = TOP / BOT |
| 170 |
EXPBYK = TOP |
| 171 |
RETURN |
| 172 |
END |
| 173 |
C SUBROUTINE READT (IUNIT,NSKIP,AIN,LENGTH,AOUT,IPOS) |
| 174 |
C**** |
| 175 |
C**** READ IN TITLE & REAL*4 ARRAY |
| 176 |
C**** |
| 177 |
C REAL*4 AIN(LENGTH),X |
| 178 |
C REAL*4 AOUT(LENGTH) |
| 179 |
C CHARACTER*80 TITLE |
| 180 |
C DO 10 N=1,IPOS-1 |
| 181 |
C 10 READ (IUNIT,END=920) |
| 182 |
C READ (IUNIT,ERR=910,END=920,NUM=LEN) TITLE,(X,N=1,NSKIP),AIN |
| 183 |
C IF(LEN.LT.4*(20+NSKIP+LENGTH)) GO TO 930 |
| 184 |
C DO 100 N=1,LENGTH |
| 185 |
C 100 AOUT(N)=AIN(N) |
| 186 |
C WRITE(6,'('' Read from Unit '',I2,'':'',A80)') IUNIT,TITLE |
| 187 |
C RETURN |
| 188 |
C 910 WRITE(6,*) 'READ ERROR ON UNIT',IUNIT |
| 189 |
C STOP 'READ ERROR' |
| 190 |
C 920 WRITE(6,*) 'END OF FILE ENCOUNTERED ON UNIT',IUNIT |
| 191 |
C STOP 'NO DATA TO READ' |
| 192 |
C 930 WRITE(6,*) LEN/4,' RATHER THAN',20+NSKIP+LENGTH,' WORDS ON UNIT', |
| 193 |
C * IUNIT |
| 194 |
C STOP 'NOT ENOUGH DATA FOUND' |
| 195 |
C END |
Parent Directory
| 
Revision Log
| 
Revision Graph