| 1 |
|
| 2 |
#include "ctrparam.h" |
| 3 |
|
| 4 |
! ========================================================== |
| 5 |
! |
| 6 |
! SULFUT.F: Subroutine for setup prescribed sulfate |
| 7 |
! aerosol forcing in the format of |
| 8 |
! surface albedo. |
| 9 |
! |
| 10 |
! ---------------------------------------------------------- |
| 11 |
! |
| 12 |
! Revision History: |
| 13 |
! |
| 14 |
! When Who What |
| 15 |
! ----- ---------- ------- |
| 16 |
! 080100 Chien Wang repack based on CliChem3 & M24x11, |
| 17 |
! and add cpp. |
| 18 |
! 081100 Chien/Andrei open cpp control for all case. |
| 19 |
! |
| 20 |
! ========================================================== |
| 21 |
|
| 22 |
subroutine sulfr_2050(BSO4LAND,BSO4OCEAN,TNOW) |
| 23 |
|
| 24 |
#include "BD2G04.COM" |
| 25 |
parameter (NYS=22) |
| 26 |
|
| 27 |
dimension BSO4LAND(JM0),BSO4OCEAN(JM0), |
| 28 |
& BSO4LD86(JM0),BSO4ON86(JM0), |
| 29 |
& BSO4LD50(JM0),BSO4ON50(JM0), |
| 30 |
& IYSULF(20),CF86(20),CF50(20) |
| 31 |
dimension CF86N(NYS),CF50N(NYS),YSULF(NYS), |
| 32 |
& BSO4LD(JM0,NYS),BSO4ON(JM0,NYS) |
| 33 |
character * 120 sulf1986,sulf2050,sulfamp |
| 34 |
common /sulfdata/sulf1986,sulf2050,sulfamp |
| 35 |
logical first |
| 36 |
data first /.true./ |
| 37 |
|
| 38 |
if(first) then |
| 39 |
JM=JM0 |
| 40 |
open (575,file=sulf1986,status='old') |
| 41 |
open (576,file=sulf2050,status='old') |
| 42 |
open (577,file=sulfamp,status='old') |
| 43 |
read (575,'(E13.5)'),(BSO4LD86(J),j=1,JM) |
| 44 |
read (575,'(E13.5)'),(BSO4ON86(J),j=1,JM) |
| 45 |
read (576,'(E13.5)'),(BSO4LD50(J),j=1,JM) |
| 46 |
read (576,'(E13.5)'),(BSO4ON50(J),j=1,JM) |
| 47 |
read (577,'(I4)'),(IYSULF(J),j=1,20) |
| 48 |
read (577,'(E13.5)'),(CF86(J),j=1,20) |
| 49 |
read (577,'(E13.5)'),(CF50(J),j=1,20) |
| 50 |
close (575) |
| 51 |
close (576) |
| 52 |
close (577) |
| 53 |
c print *,' BSO4LD86' |
| 54 |
c print ('(6F7.4)'),(BSO4LD86(J)*1.e6,j=1,JM) |
| 55 |
c print *,' BSO4ON86' |
| 56 |
c print ('(6F7.4)'),(BSO4ON86(J)*1.e6,j=1,JM) |
| 57 |
c print *,' BSO4LD50' |
| 58 |
c print ('(6F7.4)'),(BSO4LD50(J)*1.e6,j=1,JM) |
| 59 |
c print *,' BSO4ON50' |
| 60 |
c print ('(6F7.4)'),(BSO4ON50(J)*1.e6,j=1,JM) |
| 61 |
print *,'From sulfut 2050' |
| 62 |
print *,' IYSULF' |
| 63 |
print ('(5i5)'),(IYSULF(J),j=1,20) |
| 64 |
print *,' CF86' |
| 65 |
print ('(5E13.5)'),(CF86(J),j=1,20) |
| 66 |
print *,' CF50' |
| 67 |
print ('(5E13.5)'),(CF50(J),j=1,20) |
| 68 |
do n=1,20 |
| 69 |
YSULF(n)=IYSULF(n)+0.5 |
| 70 |
do j=1,jm |
| 71 |
BSO4LD(j,n)=CF86(n)*BSO4LD86(J)+CF50(n)*BSO4LD50(J) |
| 72 |
BSO4ON(j,n)=CF86(n)*BSO4ON86(J)+CF50(n)*BSO4ON50(J) |
| 73 |
enddo |
| 74 |
c print *,' n=',n,' YSULF(n)=',YSULF(n) |
| 75 |
c print *,' BSO4LD' |
| 76 |
c print ('(6F7.4)'),(BSO4LD(J,n)*1.e6,j=1,JM) |
| 77 |
enddo |
| 78 |
if(NYS.gt.20)then |
| 79 |
YSULF(21)=2150.5 |
| 80 |
YSULF(22)=2201.0 |
| 81 |
do n=21,NYS |
| 82 |
do j=1,jm |
| 83 |
BSO4LD(j,n)=CF50(20)*BSO4LD50(J) |
| 84 |
BSO4ON(j,n)=CF50(20)*BSO4ON50(J) |
| 85 |
enddo |
| 86 |
print *,' n=',n,' YSULF(n)=',YSULF(n) |
| 87 |
print *,' BSO4LD' |
| 88 |
print ('(6F7.4)'),(BSO4LD(J,n)*1.e6,j=1,JM) |
| 89 |
enddo |
| 90 |
endif |
| 91 |
print *,' YSULF' |
| 92 |
print ('(5E13.5)'),(YSULF(J),j=1,NYS) |
| 93 |
first=.false. |
| 94 |
end if |
| 95 |
do n=1,NYS-1 |
| 96 |
if(TNOW.gt.YSULF(n).and.TNOW.le.YSULF(n+1))go to 100 |
| 97 |
enddo |
| 98 |
print *,' Wrong TNOW TNOW=',TNOW |
| 99 |
stop |
| 100 |
100 continue |
| 101 |
x=(YSULF(n+1)-TNOW)/(YSULF(n+1)-YSULF(n)) |
| 102 |
do j=1,jm |
| 103 |
BSO4LAND(J)=x*BSO4LD(j,n)+(1.-x)*BSO4LD(j,n+1) |
| 104 |
BSO4OCEAN(J)=x*BSO4ON(j,n)+(1.-x)*BSO4ON(j,n+1) |
| 105 |
enddo |
| 106 |
c print *,' TNOW=',TNOW |
| 107 |
c print *,' n=',n,' YSULF(n)=',YSULF(n), |
| 108 |
c & ' YSULF(n+1)=',YSULF(n+1) |
| 109 |
c print *,' BSO4LAND' |
| 110 |
c print ('(6F7.4)'),(BSO4LAND(J)*1.e6,j=1,JM) |
| 111 |
c print *,' BSO4OCEAN' |
| 112 |
c print ('(6F7.4)'),(BSO4OCEAN(J)*1.e6,j=1,JM) |
| 113 |
|
| 114 |
return |
| 115 |
end |
Parent Directory
| 
Revision Log
| 
Revision Graph