!> \file out_profile_mod.f90 !! TOOOOOOOO DOOOOOOOOO !! !< !> \namespace out_profile !! TOOOOOOOO DOOOOOOOO !! \author ... !! \date ... !! @note Used module !! @note - use module3D_phy !< module out_profile use module3D_phy implicit none integer,dimension(:,:),allocatable :: i_prof !< tableau contenant les coordonnees des points des profils, !< ici i. la 2eme dimension pour les differents profils !< allocation de i_prof et j_prof dans inputfile-vec integer,dimension(:,:),allocatable :: j_prof !< tableau contenant les coordonnees des points des profils, !< ici j. la 2eme dimension pour les differents profils integer,dimension(:),allocatable :: nbr_pts_prof !< nombre de points dans les profils integer :: nmax integer :: num_geo character (len=50),dimension(:),allocatable :: nom_profil !< nom des fichiers profils character(len=30) :: nom_prof character(len=80) :: filin character(len=7) :: test_geon contains !> SUBROUTINE: input_profile !! Lecture des coordonnees des points de grille ou passent les profils !! @note Lecture des fichiers contenant les points i j des profiles !> subroutine input_profile !====================================== La reponse est num_rep_42 =========== write(num_rep_42,*) write(num_rep_42,*)' Fichiers profiles' write(num_rep_42,*)'------------------' !==================================================================== ! repris de modifs christophe mars 2001 ! lecture des coordonnees des points de grille ou passent les profils ! lecture des fichiers contenant les points i j des profiles nmax=200 ! a modifier si le profil contient plus de 200 pts !Lecture d'un fichier dans le repertoire des inputs : nombre de profils ? !-------------------------------------------------- filin=TRIM(DIRNAMEINP)//'file_profil_'//geoplace//'.dat' open (unit=num_geo,file=filin) read (num_geo,*) read (num_geo,*) nombre_profils,test_geon if (test_geon.ne.geoplace) then write(6,*) 'erreur sur fichiers',filin,'pour geoplace=',geoplace stop 4 endif !Allocation des variables fonctions du nombre de fichiers !-------------------------------------------------------- ! allocation de i_prof if (.not.allocated(i_prof)) THEN allocate(i_prof(nombre_profils,nmax),stat=err) if (err/=0) then print *,"Erreur à l'allocation du tableau i_prof",err stop 4 end if end if ! allocation de j_prof if (.not.allocated(j_prof)) THEN allocate(j_prof(nombre_profils,nmax),stat=err) if (err/=0) then print *,"Erreur à l'allocation du tableau j_prof",err stop 4 end if end if ! allocation de nom_profil if (.not.allocated(nom_profil)) THEN allocate(nom_profil(nombre_profils),stat=err) if (err/=0) then print *,"Erreur à l'allocation du tableau nom_profil",err stop 4 end if end if ! allocation de nbr_pts_prof if (.not.allocated(nbr_pts_prof)) THEN allocate(nbr_pts_prof(nombre_profils),stat=err) if (err/=0) then print *,"Erreur à l'allocation du tableau nbr_pts_prof",err stop 4 end if end if ! nom des fichiers des fifferents profiles do k=1,nombre_profils read (num_geo,*) nom_prof nom_profil(k)=TRIM(DIRNAMEINP)//TRIM(nom_prof) print*, nom_profil(k) enddo close(num_geo) do k=1,nombre_profils OPEN (num_file2,file=nom_profil(k)) do i=1,nmax read(num_file2,*,end=100) i_prof(k,i),j_prof(k,i) enddo 100 nbr_pts_prof(k)=i-1 close(num_file2) !====================================== La reponse est num_rep_42 =========== write(num_rep_42,*)' nb pts :',nbr_pts_prof(k),':',nom_profil(k) enddo end subroutine input_profile !--------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------- !> SUBROUTINE: sortieprofile !!Routine de sortie des resultats pour faire des profiles de la calotte !!@note Pour l'utilise il est necessaire d'avoir des fichier contenant les traces !! des profiles. !> subroutine sortieprofile ! routine de sortie des resultats pour faire des profiles de la calotte ! Pour l'utilise il est necessaire d'avoir des fichier contenant les traces ! des profiles. IMPLICIT NONE integer :: numtime !integer :: nmax integer :: n integer, dimension(:), allocatable :: nbr_ligne_prof integer :: nbr_ligne_total real :: dxkm , dykm ! resolution en kilometre !integer, dimension(200) :: i_prof, j_prof real, dimension(400) :: x_profil ! position en km sur le profil real, dimension(400,21) :: z_profil ! position verticale en km !character (len=52) :: dirname character (len=40) :: dirname !character (len=47) :: profile1 character (len=1) :: signe, unite, nt1 character (len=2) :: nt2 character (len=3) :: nt3 character (len=4) :: nt4 character (len=5) :: nt5 character (len=80) :: ffinal real, dimension(nx,ny) :: smoinsb !resolution spatiale dxkm=dx/1000 dykm=dy/1000 ! allocation de nbr_ligne_prof if (.not.allocated(nbr_ligne_prof)) THEN allocate(nbr_ligne_prof(nombre_profils),stat=err) if (err/=0) then print *,"Erreur à l'allocation du tableau nbr_ligne_prof",err stop 4 end if end if DIRNAME=TRIM(DIRNAMEOUT)!DIRNAMEOUT ! pour changer de signe entre le passe et le futur if (TIME.GT.0.) THEN signe= '+' else signe= '-' endif if (int(mod(abs(TIME),1000.)).eq.0) then ! temps multiple de 1000 unite='k' NUMTIME=nint(abs(TIME/1000.)) else if (int(mod(abs(TIME),100.)).eq.0) then ! temps multiple de 100 unite='c' NUMTIME=nint(abs(TIME/100.)) else if (int(mod(abs(TIME),10.)).eq.0) then ! temps multiple de 10 unite='d' NUMTIME=nint(abs(TIME/10.)) else ! temps en annees unite='a' NUMTIME=nint(abs(TIME/1.)) endif 921 format(i1) 922 format(i2) 923 format(i3) 924 format(i4) 925 format(i5) if (NUMTIME.lt.10) then write(nt1,921) NUMTIME ffinal=TRIM(DIRNAME)//RUNNAME//signe//unite//'00'//nt1//'.prf' else if ((NUMTIME.ge.10).and.(NUMTIME.lt.100)) then write(nt2,922) NUMTIME ffinal=TRIM(DIRNAME)//RUNNAME//signe//unite//'0'//nt2//'.prf' else if ((NUMTIME.ge.100).and.(NUMTIME.lt.1000)) then write(nt3,923) NUMTIME ffinal=TRIM(DIRNAME)//RUNNAME//signe//unite//nt3//'.prf' else if ((NUMTIME.ge.1000).and.(NUMTIME.lt.10000)) then write(nt4,924) NUMTIME ffinal=TRIM(DIRNAME)//RUNNAME//signe//unite//nt4//'.prf' else if ((NUMTIME.ge.10000).and.(NUMTIME.lt.100000)) then write(nt5,925) NUMTIME ffinal=TRIM(DIRNAME)//RUNNAME//signe//unite//nt5//'.prf' else ffinal=TRIM(DIRNAME)//RUNNAME//signe//'out'//'.prf' endif open (num_file1,file=FFINAL) nbr_ligne_prof(:)=nbr_pts_prof(:)*21+1 nbr_ligne_total=sum(nbr_ligne_prof) write(num_file1,*) (nbr_ligne_prof(i),i=1,nombre_profils),nbr_ligne_total ! boucle sur le nombre de profil a effectuer Do i=1,nombre_profils ! calcul de la position des points sur le profil en km do k=1,nz z_profil(1,k)=S(i_prof(i,1),j_prof(i,1))-((S(i_prof(i,1),j_prof(i,1)) - & B(i_prof(i,1),j_prof(i,1)))*(k-1)/20) enddo x_profil(1)= 0 do n=2,nbr_pts_prof(i) x_profil(n)= x_profil(n-1) + (((i_prof(i,n)-i_prof(i,n-1))*dxkm)**2 + & ((j_prof(i,n)-j_prof(i,n-1))*dykm)**2)**0.5 SMOINSB(i_prof(i,n),j_prof(i,n))=S(i_prof(i,n),j_prof(i,n)) & -B(i_prof(i,n),j_prof(i,n)) do k=1,nz z_profil(n,k)=S(i_prof(i,n),j_prof(i,n))- & (SMOINSB(i_prof(i,n),j_prof(i,n))*(k-1)/20) enddo enddo ! ecriture du fichier .prf ! nombre de ligne du profil ! 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 ! i et j sont les coordonnees des points dans la grille du modele ! n est le no du point horizontalement sur le profil. 1 2 3 4 ... ! k est le no verticale sur le profil (de 1 a 21) ! B est le fond de la glace ! BSOC est le socle 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' do n=1,nbr_pts_prof(i) do k=1,nz write(num_file1,912) i_prof(i,n),j_prof(i,n),n,k,x_profil(n),z_profil(n,k), & T(i_prof(i,n),j_prof(i,n),k),UX(i_prof(i,n),j_prof(i,n),k), & UX(i_prof(i,n)+1,j_prof(i,n),k),UY(i_prof(i,n),j_prof(i,n),k), & UY(i_prof(i,n),j_prof(i,n)+1,k),UZR(i_prof(i,n),j_prof(i,n),k), & 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)) enddo enddo enddo close(num_file1) 912 format(4(i3,1x),11(f8.2,1x)) deallocate(nbr_ligne_prof,stat=err) if (err/=0) then print *,"Erreur à l'allocation du tableau nbr_ligne_prof",err stop 4 end if end subroutine sortieprofile !---------------------------------------------------------------------------------------! !---------------------------------------------------------------------------------------! end module out_profile