Changeset 425 for branches/GRISLIv3

Timestamp:

04/25/23 11:40:22 (15 months ago)

Author:

dumas

Message:

Use only in out_profile

Location:

branches/GRISLIv3/SOURCES

Files:

• 3D-physique-gen_mod.f90 (modified) (1 diff)
• out_profile_mod.f90 (modified) (2 diffs)

branches/GRISLIv3/SOURCES/3D-physique-gen_mod.f90

@@ -72 +72 @@
   !integer, dimension(NX,NY) ::  LIGV    !< numero de ligne de V dans remplidom
 
-  integer :: nombre_profils !< nombre de profils de la calotte
   integer :: itracer                    ! pour ecrire les recovery avec ou sans les tableaux traceurs
 

branches/GRISLIv3/SOURCES/out_profile_mod.f90

@@ -13 +13 @@
 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
   
-
-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
+  integer :: nombre_profils !< nombre de profils de la calotte
+  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
+  !! 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
+    
+    use module3D_phy, only: num_rep_42,num_file2
+    use geography, only: dirnameinp,geoplace
+    
+    integer :: err
+    integer :: i, k
     !====================================== La reponse est num_rep_42 ===========
     write(num_rep_42,*)
@@ -127 +131 @@
 
   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)
+  !---------------------------------------------------------------------------------------
+  !---------------------------------------------------------------------------------------
+  !---------------------------------------------------------------------------------------
+  !> 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.
+  !>
+
+  ! 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.
+  subroutine sortieprofile
+    
+    use module3D_phy, only:time,num_file1,S,B,T,ux,uy,uzr,Bsoc
+    use runparam, only: runname,dirnameout
+    use geography, only: dx,dy,nz,nx,ny
+
+    integer :: numtime
+    !integer :: nmax
+    integer :: n,err,i,k
+    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
-!---------------------------------------------------------------------------------------!
-!---------------------------------------------------------------------------------------!
+    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