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