| 1 | SUBROUTINE load_ksi(ksive) |
|---|
| 2 | |
|---|
| 3 | use dimphy |
|---|
| 4 | IMPLICIT none |
|---|
| 5 | |
|---|
| 6 | #include "dimensions.h" |
|---|
| 7 | #include "YOMCST.h" |
|---|
| 8 | #include "comcstVE.h" |
|---|
| 9 | C |
|---|
| 10 | C ------------------------------------------------------------------ |
|---|
| 11 | C |
|---|
| 12 | C PURPOSE. |
|---|
| 13 | C -------- |
|---|
| 14 | C |
|---|
| 15 | c This routine loads the longwave matrix of factors Ksi |
|---|
| 16 | c |
|---|
| 17 | c The Ksi matrixes have been computed by Vincent Eymet |
|---|
| 18 | C |
|---|
| 19 | C AUTHOR. |
|---|
| 20 | C ------- |
|---|
| 21 | C Sebastien Lebonnois |
|---|
| 22 | C |
|---|
| 23 | C MODIFICATIONS. |
|---|
| 24 | C -------------- |
|---|
| 25 | C |
|---|
| 26 | c New ksi matrix: possibility of different cloud model fct of lat 05/2014 |
|---|
| 27 | C ------------------------------------------------------------------ |
|---|
| 28 | C |
|---|
| 29 | C* ARGUMENTS: |
|---|
| 30 | C |
|---|
| 31 | c inputs |
|---|
| 32 | real psurf(klon) ! Surface pressure |
|---|
| 33 | c outputs |
|---|
| 34 | real ksive(0:klev+1,0:klev+1,nnuve,nbmat) ! ksi matrixes in Vincent's file |
|---|
| 35 | |
|---|
| 36 | c local variables |
|---|
| 37 | integer i,j,isza,ips,band,pve,sve,nlve |
|---|
| 38 | integer lat,Nb,m,mat |
|---|
| 39 | character*9 tmp1 |
|---|
| 40 | character*100 file |
|---|
| 41 | CHARACTER*2 str2 |
|---|
| 42 | real lambda(nnuve) ! wavelenght in table (mu->m, middle of interval) |
|---|
| 43 | real lambdamin(nnuve),lambdamax(nnuve) ! in microns |
|---|
| 44 | real dlambda ! in microns |
|---|
| 45 | |
|---|
| 46 | nlve = klev |
|---|
| 47 | |
|---|
| 48 | c ------------------------ |
|---|
| 49 | c Loading the ksi file |
|---|
| 50 | c ------------------------ |
|---|
| 51 | |
|---|
| 52 | file = "ksi_global.txt" |
|---|
| 53 | open(10,file=file) |
|---|
| 54 | |
|---|
| 55 | read(10,*) |
|---|
| 56 | read(10,*) nlatve |
|---|
| 57 | read(10,*) |
|---|
| 58 | |
|---|
| 59 | write(*,*) 'This is subroutine load_ksi' |
|---|
| 60 | write(*,*) 'Nb of lat bands:',nlatve |
|---|
| 61 | |
|---|
| 62 | do lat=1,nlatve |
|---|
| 63 | read(10,*) !line for lat range |
|---|
| 64 | read(10,*) indexve(lat) |
|---|
| 65 | read(10,*) nbpsve(lat) |
|---|
| 66 | read(10,*) |
|---|
| 67 | read(10,*) nbszave(lat) |
|---|
| 68 | read(10,*) |
|---|
| 69 | |
|---|
| 70 | do isza=1,nbszave(lat) |
|---|
| 71 | do ips=1,nbpsve(lat) |
|---|
| 72 | |
|---|
| 73 | read(10,*) (tmp1,j=1,3),mat !line for matrix number |
|---|
| 74 | read(10,*) (tmp1,j=1,2),pve |
|---|
| 75 | psurfve(ips,lat) = pve*1.e5 ! pve in bar, psurfve in Pa |
|---|
| 76 | read(10,*) (tmp1,j=1,3),sve |
|---|
| 77 | szave(isza,lat) = cos(sve*RPI/180.) ! conversion in mu0 |
|---|
| 78 | read(10,*) |
|---|
| 79 | read(10,*) m,Nb |
|---|
| 80 | if (m.ne.nlve) then |
|---|
| 81 | write(*,*) 'This is subroutine load_ksi' |
|---|
| 82 | print*,'Dimension problem between ksi.txt and nlve' |
|---|
| 83 | print*,'N levels = ',m,nlve |
|---|
| 84 | stop |
|---|
| 85 | endif |
|---|
| 86 | if (Nb.ne.nnuve) then |
|---|
| 87 | write(*,*) 'This is subroutine load_ksi' |
|---|
| 88 | print*,'Dimension problem between ksi.txt and nnuve' |
|---|
| 89 | print*,'N freq = ',Nb,nnuve |
|---|
| 90 | stop |
|---|
| 91 | endif |
|---|
| 92 | c Now reading ksi matrix index "mat" |
|---|
| 93 | write(str2,'(i2.2)') m+2 |
|---|
| 94 | do band=1,Nb |
|---|
| 95 | read(10,*) lambdamin(band),lambdamax(band) |
|---|
| 96 | do i=0,m+1 |
|---|
| 97 | read(10,'('//str2//'e17.9)') (ksive(i,j,band,mat),j=0,m+1) ! no unit |
|---|
| 98 | enddo ! i |
|---|
| 99 | enddo ! band |
|---|
| 100 | c print*,"Matrice ",mat," lue" |
|---|
| 101 | c print*," psurf=",psurfve(ips,lat)," bars" |
|---|
| 102 | if (mat+1.gt.nbmat) then |
|---|
| 103 | write(*,*) 'This is subroutine load_ksi' |
|---|
| 104 | print*,'Dimension problem between ksi.txt and nbmat' |
|---|
| 105 | print*,'(max number of matrixes)' |
|---|
| 106 | print*,'nbmat (in comcstVE.h) should be raised' |
|---|
| 107 | stop |
|---|
| 108 | endif |
|---|
| 109 | |
|---|
| 110 | enddo ! ips |
|---|
| 111 | enddo ! isza |
|---|
| 112 | enddo ! lat |
|---|
| 113 | |
|---|
| 114 | write(*,*) 'Total nb of matrixes:',mat |
|---|
| 115 | |
|---|
| 116 | close(10) |
|---|
| 117 | |
|---|
| 118 | c central wavelength and wavelength width |
|---|
| 119 | do band=1,nnuve |
|---|
| 120 | lambda(band)=(lambdamin(band)+lambdamax(band))/2.*1.e-6 ! in m |
|---|
| 121 | dlambda =(lambdamax(band)-lambdamin(band)) ! in microns |
|---|
| 122 | c print*,band,lambdamin(band),dlambda,lambdamax(band) |
|---|
| 123 | |
|---|
| 124 | c sign convention for ksi, |
|---|
| 125 | c and taking into account the wavelength width (in microns): |
|---|
| 126 | do mat=1,nbmat |
|---|
| 127 | do i=0,nlve+1 |
|---|
| 128 | do j=0,nlve+1 |
|---|
| 129 | ksive(i,j,band,mat) = +ksive(i,j,band,mat)*dlambda ! in µm |
|---|
| 130 | enddo |
|---|
| 131 | enddo |
|---|
| 132 | enddo |
|---|
| 133 | c computing coeff al and bl for Planck luminance |
|---|
| 134 | al(band) = 2.*RHPLA*RCLUM*RCLUM/(lambda(band))**5. |
|---|
| 135 | c in W/m²/m |
|---|
| 136 | c We need W/m²/µm : |
|---|
| 137 | . * 1.e-6 |
|---|
| 138 | bl(band) = RHPLA*RCLUM/(RKBOL*lambda(band)) |
|---|
| 139 | enddo |
|---|
| 140 | |
|---|
| 141 | print*,"LOAD_KSI OK" |
|---|
| 142 | |
|---|
| 143 | return |
|---|
| 144 | end |
|---|
| 145 | |
|---|
