source: trunk/SOURCES/out_profile_mod.f90 @ 334

Last change on this file since 334 was 65, checked in by dumas, 8 years ago

Deleting unused variables and move old sources
File size: 9.1 KB
Line 
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!<
13module out_profile
14
15  use module3D_phy
16 
17
18implicit none
19integer,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
22integer,dimension(:,:),allocatable :: j_prof !< tableau contenant les coordonnees des points des profils,
23                                             !<  ici j. la 2eme dimension pour les differents profils
24
25integer,dimension(:),allocatable :: nbr_pts_prof          !< nombre de points dans les profils
26integer :: nmax
27integer :: num_geo
28
29character (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
34contains
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
121100    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
138subroutine 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
144IMPLICIT NONE
145
146integer :: numtime
147!integer :: nmax
148integer :: n
149integer, dimension(:), allocatable :: nbr_ligne_prof
150integer :: nbr_ligne_total
151real :: dxkm , dykm ! resolution en kilometre
152!integer, dimension(200) :: i_prof, j_prof
153real, dimension(400) :: x_profil ! position en km sur le profil
154real, dimension(400,21) :: z_profil ! position verticale en km
155!character (len=52) :: dirname
156character (len=40) :: dirname
157!character (len=47) :: profile1
158character (len=1) :: signe, unite, nt1
159character (len=2) :: nt2
160character (len=3) :: nt3
161character (len=4) :: nt4
162character (len=5) :: nt5
163character (len=80) :: ffinal
164real, dimension(nx,ny) :: smoinsb
165
166
167!resolution spatiale
168dxkm=dx/1000
169dykm=dy/1000
170
171! allocation de nbr_ligne_prof
172if (.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
178end if
179
180
181DIRNAME=TRIM(DIRNAMEOUT)!DIRNAMEOUT
182
183
184
185! pour changer de signe entre le passe et le futur
186if (TIME.GT.0.) THEN
187   signe= '+'
188else
189   signe= '-'
190endif
191
192
193if (int(mod(abs(TIME),1000.)).eq.0) then
194!     temps multiple de 1000
195   unite='k'
196   NUMTIME=nint(abs(TIME/1000.))
197else if (int(mod(abs(TIME),100.)).eq.0) then
198!     temps multiple de 100
199   unite='c'
200   NUMTIME=nint(abs(TIME/100.))
201else if (int(mod(abs(TIME),10.)).eq.0) then
202!     temps multiple de 10
203   unite='d'
204   NUMTIME=nint(abs(TIME/10.))
205else
206!     temps en annees
207   unite='a'
208   NUMTIME=nint(abs(TIME/1.))
209endif
210
211921   format(i1)
212922   format(i2)
213923   format(i3)
214924   format(i4)
215925   format(i5)
216
217
218if (NUMTIME.lt.10) then
219   write(nt1,921) NUMTIME
220   ffinal=TRIM(DIRNAME)//RUNNAME//signe//unite//'00'//nt1//'.prf'
221else if ((NUMTIME.ge.10).and.(NUMTIME.lt.100)) then
222   write(nt2,922) NUMTIME
223   ffinal=TRIM(DIRNAME)//RUNNAME//signe//unite//'0'//nt2//'.prf'
224else if ((NUMTIME.ge.100).and.(NUMTIME.lt.1000)) then
225   write(nt3,923) NUMTIME
226   ffinal=TRIM(DIRNAME)//RUNNAME//signe//unite//nt3//'.prf'
227else if ((NUMTIME.ge.1000).and.(NUMTIME.lt.10000)) then
228   write(nt4,924) NUMTIME
229   ffinal=TRIM(DIRNAME)//RUNNAME//signe//unite//nt4//'.prf'
230else if ((NUMTIME.ge.10000).and.(NUMTIME.lt.100000)) then
231   write(nt5,925) NUMTIME
232   ffinal=TRIM(DIRNAME)//RUNNAME//signe//unite//nt5//'.prf'
233else
234   ffinal=TRIM(DIRNAME)//RUNNAME//signe//'out'//'.prf'
235endif
236
237open (num_file1,file=FFINAL)
238
239nbr_ligne_prof(:)=nbr_pts_prof(:)*21+1
240nbr_ligne_total=sum(nbr_ligne_prof)
241
242write(num_file1,*) (nbr_ligne_prof(i),i=1,nombre_profils),nbr_ligne_total
243
244! boucle sur le nombre de profil a effectuer
245Do i=1,nombre_profils
246
247
248
249! calcul de la position des points sur le profil en km
250
251
252do 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)
255enddo
256
257
258x_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
284write(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
286do 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
294enddo
295
296enddo
297close(num_file1)
298
299912 format(4(i3,1x),11(f8.2,1x))
300deallocate(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
306end subroutine sortieprofile
307!---------------------------------------------------------------------------------------!
308!---------------------------------------------------------------------------------------!
309end module out_profile
Note: See TracBrowser for help on using the repository browser.