[4] | 1 | !> \file out_profile_mod.f90 |
---|
| 2 | !! TOOOOOOOO DOOOOOOOOO |
---|
| 3 | !! |
---|
| 4 | !< |
---|
| 5 | |
---|
| 6 | !> \namespace out_profile |
---|
| 7 | !! TOOOOOOOO DOOOOOOOO |
---|
| 8 | !! \author ... |
---|
| 9 | !! \date ... |
---|
| 10 | !! @note Used module |
---|
| 11 | !! @note - use module3D_phy |
---|
| 12 | !< |
---|
| 13 | module out_profile |
---|
| 14 | |
---|
| 15 | use module3D_phy |
---|
| 16 | |
---|
| 17 | |
---|
| 18 | implicit none |
---|
| 19 | integer,dimension(:,:),allocatable :: i_prof !< tableau contenant les coordonnees des points des profils, |
---|
| 20 | !< ici i. la 2eme dimension pour les differents profils |
---|
| 21 | !< allocation de i_prof et j_prof dans inputfile-vec |
---|
| 22 | integer,dimension(:,:),allocatable :: j_prof !< tableau contenant les coordonnees des points des profils, |
---|
| 23 | !< ici j. la 2eme dimension pour les differents profils |
---|
| 24 | |
---|
| 25 | integer,dimension(:),allocatable :: nbr_pts_prof !< nombre de points dans les profils |
---|
| 26 | integer :: nmax |
---|
| 27 | integer :: num_geo |
---|
| 28 | |
---|
| 29 | character (len=50),dimension(:),allocatable :: nom_profil !< nom des fichiers profils |
---|
| 30 | character(len=30) :: nom_prof |
---|
| 31 | character(len=80) :: filin |
---|
| 32 | character(len=7) :: test_geon |
---|
| 33 | |
---|
| 34 | contains |
---|
| 35 | !> SUBROUTINE: input_profile |
---|
| 36 | !! Lecture des coordonnees des points de grille ou passent les profils |
---|
| 37 | !! @note Lecture des fichiers contenant les points i j des profiles |
---|
| 38 | !> |
---|
| 39 | subroutine input_profile |
---|
| 40 | !====================================== La reponse est num_rep_42 =========== |
---|
| 41 | write(num_rep_42,*) |
---|
| 42 | write(num_rep_42,*)' Fichiers profiles' |
---|
| 43 | write(num_rep_42,*)'------------------' |
---|
| 44 | !==================================================================== |
---|
| 45 | |
---|
| 46 | |
---|
| 47 | ! repris de modifs christophe mars 2001 |
---|
| 48 | ! lecture des coordonnees des points de grille ou passent les profils |
---|
| 49 | ! lecture des fichiers contenant les points i j des profiles |
---|
| 50 | |
---|
| 51 | |
---|
| 52 | nmax=200 ! a modifier si le profil contient plus de 200 pts |
---|
| 53 | |
---|
| 54 | !Lecture d'un fichier dans le repertoire des inputs : nombre de profils ? |
---|
| 55 | !-------------------------------------------------- |
---|
| 56 | filin=TRIM(DIRNAMEINP)//'file_profil_'//geoplace//'.dat' |
---|
| 57 | |
---|
| 58 | open (unit=num_geo,file=filin) |
---|
| 59 | read (num_geo,*) |
---|
| 60 | read (num_geo,*) nombre_profils,test_geon |
---|
| 61 | |
---|
| 62 | if (test_geon.ne.geoplace) then |
---|
| 63 | write(6,*) 'erreur sur fichiers',filin,'pour geoplace=',geoplace |
---|
| 64 | stop 4 |
---|
| 65 | endif |
---|
| 66 | |
---|
| 67 | !Allocation des variables fonctions du nombre de fichiers |
---|
| 68 | !-------------------------------------------------------- |
---|
| 69 | ! allocation de i_prof |
---|
| 70 | |
---|
| 71 | if (.not.allocated(i_prof)) THEN |
---|
| 72 | allocate(i_prof(nombre_profils,nmax),stat=err) |
---|
| 73 | if (err/=0) then |
---|
| 74 | print *,"Erreur à l'allocation du tableau i_prof",err |
---|
| 75 | stop 4 |
---|
| 76 | end if |
---|
| 77 | end if |
---|
| 78 | ! allocation de j_prof |
---|
| 79 | |
---|
| 80 | if (.not.allocated(j_prof)) THEN |
---|
| 81 | allocate(j_prof(nombre_profils,nmax),stat=err) |
---|
| 82 | if (err/=0) then |
---|
| 83 | print *,"Erreur à l'allocation du tableau j_prof",err |
---|
| 84 | stop 4 |
---|
| 85 | end if |
---|
| 86 | end if |
---|
| 87 | ! allocation de nom_profil |
---|
| 88 | if (.not.allocated(nom_profil)) THEN |
---|
| 89 | allocate(nom_profil(nombre_profils),stat=err) |
---|
| 90 | if (err/=0) then |
---|
| 91 | print *,"Erreur à l'allocation du tableau nom_profil",err |
---|
| 92 | stop 4 |
---|
| 93 | end if |
---|
| 94 | end if |
---|
| 95 | ! allocation de nbr_pts_prof |
---|
| 96 | |
---|
| 97 | if (.not.allocated(nbr_pts_prof)) THEN |
---|
| 98 | allocate(nbr_pts_prof(nombre_profils),stat=err) |
---|
| 99 | if (err/=0) then |
---|
| 100 | print *,"Erreur à l'allocation du tableau nbr_pts_prof",err |
---|
| 101 | stop 4 |
---|
| 102 | end if |
---|
| 103 | end if |
---|
| 104 | |
---|
| 105 | ! nom des fichiers des fifferents profiles |
---|
| 106 | do k=1,nombre_profils |
---|
| 107 | read (num_geo,*) nom_prof |
---|
| 108 | nom_profil(k)=TRIM(DIRNAMEINP)//TRIM(nom_prof) |
---|
| 109 | print*, nom_profil(k) |
---|
| 110 | enddo |
---|
| 111 | |
---|
| 112 | close(num_geo) |
---|
| 113 | |
---|
| 114 | do k=1,nombre_profils |
---|
| 115 | |
---|
| 116 | OPEN (num_file2,file=nom_profil(k)) |
---|
| 117 | |
---|
| 118 | do i=1,nmax |
---|
| 119 | read(num_file2,*,end=100) i_prof(k,i),j_prof(k,i) |
---|
| 120 | enddo |
---|
| 121 | 100 nbr_pts_prof(k)=i-1 |
---|
| 122 | close(num_file2) |
---|
| 123 | !====================================== La reponse est num_rep_42 =========== |
---|
| 124 | write(num_rep_42,*)' nb pts :',nbr_pts_prof(k),':',nom_profil(k) |
---|
| 125 | enddo |
---|
| 126 | |
---|
| 127 | |
---|
| 128 | end subroutine input_profile |
---|
| 129 | !--------------------------------------------------------------------------------------- |
---|
| 130 | !--------------------------------------------------------------------------------------- |
---|
| 131 | !--------------------------------------------------------------------------------------- |
---|
| 132 | !> SUBROUTINE: sortieprofile |
---|
| 133 | !!Routine de sortie des resultats pour faire des profiles de la calotte |
---|
| 134 | !!@note Pour l'utilise il est necessaire d'avoir des fichier contenant les traces |
---|
| 135 | !! des profiles. |
---|
| 136 | !> |
---|
| 137 | |
---|
| 138 | subroutine sortieprofile |
---|
| 139 | |
---|
| 140 | ! routine de sortie des resultats pour faire des profiles de la calotte |
---|
| 141 | ! Pour l'utilise il est necessaire d'avoir des fichier contenant les traces |
---|
| 142 | ! des profiles. |
---|
| 143 | |
---|
| 144 | IMPLICIT NONE |
---|
| 145 | |
---|
| 146 | integer :: numtime |
---|
| 147 | !integer :: nmax |
---|
| 148 | integer :: n,l |
---|
| 149 | integer, dimension(:), allocatable :: nbr_ligne_prof |
---|
| 150 | integer :: nbr_ligne_total |
---|
| 151 | real :: dxkm , dykm ! resolution en kilometre |
---|
| 152 | !integer, dimension(200) :: i_prof, j_prof |
---|
| 153 | real, dimension(400) :: x_profil ! position en km sur le profil |
---|
| 154 | real, dimension(400,21) :: z_profil ! position verticale en km |
---|
| 155 | !character (len=52) :: dirname |
---|
| 156 | character (len=40) :: dirname |
---|
| 157 | !character (len=47) :: profile1 |
---|
| 158 | character (len=1) :: signe, unite, nt1 |
---|
| 159 | character (len=2) :: nt2 |
---|
| 160 | character (len=3) :: nt3 |
---|
| 161 | character (len=4) :: nt4 |
---|
| 162 | character (len=5) :: nt5 |
---|
| 163 | character (len=80) :: ffinal |
---|
| 164 | real, dimension(nx,ny) :: smoinsb |
---|
| 165 | |
---|
| 166 | |
---|
| 167 | !resolution spatiale |
---|
| 168 | dxkm=dx/1000 |
---|
| 169 | dykm=dy/1000 |
---|
| 170 | |
---|
| 171 | ! allocation de nbr_ligne_prof |
---|
| 172 | if (.not.allocated(nbr_ligne_prof)) THEN |
---|
| 173 | allocate(nbr_ligne_prof(nombre_profils),stat=err) |
---|
| 174 | if (err/=0) then |
---|
| 175 | print *,"Erreur à l'allocation du tableau nbr_ligne_prof",err |
---|
| 176 | stop 4 |
---|
| 177 | end if |
---|
| 178 | end if |
---|
| 179 | |
---|
| 180 | |
---|
| 181 | DIRNAME=TRIM(DIRNAMEOUT)!DIRNAMEOUT |
---|
| 182 | |
---|
| 183 | |
---|
| 184 | |
---|
| 185 | ! pour changer de signe entre le passe et le futur |
---|
| 186 | if (TIME.GT.0.) THEN |
---|
| 187 | signe= '+' |
---|
| 188 | else |
---|
| 189 | signe= '-' |
---|
| 190 | endif |
---|
| 191 | |
---|
| 192 | |
---|
| 193 | if (int(mod(abs(TIME),1000.)).eq.0) then |
---|
| 194 | ! temps multiple de 1000 |
---|
| 195 | unite='k' |
---|
| 196 | NUMTIME=nint(abs(TIME/1000.)) |
---|
| 197 | else if (int(mod(abs(TIME),100.)).eq.0) then |
---|
| 198 | ! temps multiple de 100 |
---|
| 199 | unite='c' |
---|
| 200 | NUMTIME=nint(abs(TIME/100.)) |
---|
| 201 | else if (int(mod(abs(TIME),10.)).eq.0) then |
---|
| 202 | ! temps multiple de 10 |
---|
| 203 | unite='d' |
---|
| 204 | NUMTIME=nint(abs(TIME/10.)) |
---|
| 205 | else |
---|
| 206 | ! temps en annees |
---|
| 207 | unite='a' |
---|
| 208 | NUMTIME=nint(abs(TIME/1.)) |
---|
| 209 | endif |
---|
| 210 | |
---|
| 211 | 921 format(i1) |
---|
| 212 | 922 format(i2) |
---|
| 213 | 923 format(i3) |
---|
| 214 | 924 format(i4) |
---|
| 215 | 925 format(i5) |
---|
| 216 | |
---|
| 217 | |
---|
| 218 | if (NUMTIME.lt.10) then |
---|
| 219 | write(nt1,921) NUMTIME |
---|
| 220 | ffinal=TRIM(DIRNAME)//RUNNAME//signe//unite//'00'//nt1//'.prf' |
---|
| 221 | else if ((NUMTIME.ge.10).and.(NUMTIME.lt.100)) then |
---|
| 222 | write(nt2,922) NUMTIME |
---|
| 223 | ffinal=TRIM(DIRNAME)//RUNNAME//signe//unite//'0'//nt2//'.prf' |
---|
| 224 | else if ((NUMTIME.ge.100).and.(NUMTIME.lt.1000)) then |
---|
| 225 | write(nt3,923) NUMTIME |
---|
| 226 | ffinal=TRIM(DIRNAME)//RUNNAME//signe//unite//nt3//'.prf' |
---|
| 227 | else if ((NUMTIME.ge.1000).and.(NUMTIME.lt.10000)) then |
---|
| 228 | write(nt4,924) NUMTIME |
---|
| 229 | ffinal=TRIM(DIRNAME)//RUNNAME//signe//unite//nt4//'.prf' |
---|
| 230 | else if ((NUMTIME.ge.10000).and.(NUMTIME.lt.100000)) then |
---|
| 231 | write(nt5,925) NUMTIME |
---|
| 232 | ffinal=TRIM(DIRNAME)//RUNNAME//signe//unite//nt5//'.prf' |
---|
| 233 | else |
---|
| 234 | ffinal=TRIM(DIRNAME)//RUNNAME//signe//'out'//'.prf' |
---|
| 235 | endif |
---|
| 236 | |
---|
| 237 | open (num_file1,file=FFINAL) |
---|
| 238 | |
---|
| 239 | nbr_ligne_prof(:)=nbr_pts_prof(:)*21+1 |
---|
| 240 | nbr_ligne_total=sum(nbr_ligne_prof) |
---|
| 241 | |
---|
| 242 | write(num_file1,*) (nbr_ligne_prof(i),i=1,nombre_profils),nbr_ligne_total |
---|
| 243 | |
---|
| 244 | ! boucle sur le nombre de profil a effectuer |
---|
| 245 | Do i=1,nombre_profils |
---|
| 246 | |
---|
| 247 | |
---|
| 248 | |
---|
| 249 | ! calcul de la position des points sur le profil en km |
---|
| 250 | |
---|
| 251 | |
---|
| 252 | do k=1,nz |
---|
| 253 | z_profil(1,k)=S(i_prof(i,1),j_prof(i,1))-((S(i_prof(i,1),j_prof(i,1)) - & |
---|
| 254 | B(i_prof(i,1),j_prof(i,1)))*(k-1)/20) |
---|
| 255 | enddo |
---|
| 256 | |
---|
| 257 | |
---|
| 258 | x_profil(1)= 0 |
---|
| 259 | |
---|
| 260 | do n=2,nbr_pts_prof(i) |
---|
| 261 | x_profil(n)= x_profil(n-1) + (((i_prof(i,n)-i_prof(i,n-1))*dxkm)**2 + & |
---|
| 262 | ((j_prof(i,n)-j_prof(i,n-1))*dykm)**2)**0.5 |
---|
| 263 | SMOINSB(i_prof(i,n),j_prof(i,n))=S(i_prof(i,n),j_prof(i,n)) & |
---|
| 264 | -B(i_prof(i,n),j_prof(i,n)) |
---|
| 265 | do k=1,nz |
---|
| 266 | z_profil(n,k)=S(i_prof(i,n),j_prof(i,n))- & |
---|
| 267 | (SMOINSB(i_prof(i,n),j_prof(i,n))*(k-1)/20) |
---|
| 268 | enddo |
---|
| 269 | enddo |
---|
| 270 | |
---|
| 271 | |
---|
| 272 | |
---|
| 273 | |
---|
| 274 | ! ecriture du fichier .prf |
---|
| 275 | ! nombre de ligne du profil |
---|
| 276 | ! i,j,n,k,x(km),z(km),T,Ux(i,j,1,nz),Ux(i+1,j,1,nz),Uy(i,j,1,nz),Uy(i,j+1,1,nz),UZR(i,j,nz),S,B,BSOC |
---|
| 277 | ! i et j sont les coordonnees des points dans la grille du modele |
---|
| 278 | ! n est le no du point horizontalement sur le profil. 1 2 3 4 ... |
---|
| 279 | ! k est le no verticale sur le profil (de 1 a 21) |
---|
| 280 | ! B est le fond de la glace |
---|
| 281 | ! BSOC est le socle |
---|
| 282 | |
---|
| 283 | |
---|
| 284 | write(num_file1,*) 'i j n k x(km) z(km) T Ux(i,j) Ux(i+1,j) Uy(i,j) Uy(i,j+1) UZR(i,j) S B BSOC' |
---|
| 285 | |
---|
| 286 | do n=1,nbr_pts_prof(i) |
---|
| 287 | do k=1,nz |
---|
| 288 | write(num_file1,912) i_prof(i,n),j_prof(i,n),n,k,x_profil(n),z_profil(n,k), & |
---|
| 289 | T(i_prof(i,n),j_prof(i,n),k),UX(i_prof(i,n),j_prof(i,n),k), & |
---|
| 290 | UX(i_prof(i,n)+1,j_prof(i,n),k),UY(i_prof(i,n),j_prof(i,n),k), & |
---|
| 291 | UY(i_prof(i,n),j_prof(i,n)+1,k),UZR(i_prof(i,n),j_prof(i,n),k), & |
---|
| 292 | S(i_prof(i,n),j_prof(i,n)),B(i_prof(i,n),j_prof(i,n)),BSOC(i_prof(i,n),j_prof(i,n)) |
---|
| 293 | enddo |
---|
| 294 | enddo |
---|
| 295 | |
---|
| 296 | enddo |
---|
| 297 | close(num_file1) |
---|
| 298 | |
---|
| 299 | 912 format(4(i3,1x),11(f8.2,1x)) |
---|
| 300 | deallocate(nbr_ligne_prof,stat=err) |
---|
| 301 | if (err/=0) then |
---|
| 302 | print *,"Erreur à l'allocation du tableau nbr_ligne_prof",err |
---|
| 303 | stop 4 |
---|
| 304 | end if |
---|
| 305 | |
---|
| 306 | end subroutine sortieprofile |
---|
| 307 | !---------------------------------------------------------------------------------------! |
---|
| 308 | !---------------------------------------------------------------------------------------! |
---|
| 309 | end module out_profile |
---|