Blame view

src/main.f90 3.98 KB
a081b91c   Jérémy Baudry   new
1
2
3
4
5
6
7
8
!
!_________________________________________________________________________________        
        !DESCRIPTION:
!       This is the main program of WIM. This routine merely calls other
!       subroutines and do the main time loop. It also contains the subroutine
!       progress which display a progress bar in the terminal while the model is
!       running.
!_________________________________________________________________________________
81dede1c   Jérémy Baudry   first commit
9

a081b91c   Jérémy Baudry   new
10
11
        !INTERFACE:
        PROGRAM WIM2
81dede1c   Jérémy Baudry   first commit
12

a081b91c   Jérémy Baudry   new
13
14
        !MODULE USES:
        use parameters
81dede1c   Jérémy Baudry   first commit
15

a081b91c   Jérémy Baudry   new
16
        
c5b6a1a5   Jérémy Baudry   makefile and disp...
17
18
19
20

        
        call message(1)

a081b91c   Jérémy Baudry   new
21
        call read_namelist              !read parameters from namelists
c5b6a1a5   Jérémy Baudry   makefile and disp...
22
23
        call message(2)
        
a081b91c   Jérémy Baudry   new
24
        call array_allocation           ! allocate memory for arrays
c5b6a1a5   Jérémy Baudry   makefile and disp...
25
26
        call message(3)

a081b91c   Jérémy Baudry   new
27
        call initialization             ! initialize the model
c5b6a1a5   Jérémy Baudry   makefile and disp...
28
        call message(4)
81dede1c   Jérémy Baudry   first commit
29

68586e03   Jérémy Baudry   new release
30
31
32
33
34
           dirout=trim(root)//trim(name_sim)
        open(25,file='src/tmp.txt')
        write(25,*)trim(dirout)
        close(25)
        call system('src/OUT_DIR.sh')
81dede1c   Jérémy Baudry   first commit
35

a081b91c   Jérémy Baudry   new
36
37
38

!________________________________________________________________________________
!                DO THE TIME LOOP
c5b6a1a5   Jérémy Baudry   makefile and disp...
39
40
        
        call message(5)
a081b91c   Jérémy Baudry   new
41
42
43
44
45
46
47
48
49
50
51
        do n=2,nsteps

                call progress(n,nsteps)         !display progress bar
                do ii=1,nfreq                   !do advection for each frequency
                                                !band
                        call advection
                end do

                do i=1,nbin                     !spatial calculations

                call attenuation                ! compute spectrum attenuation
4e5b4414   Jérémy Baudry   ajout commentaire...
52
                                                ! compute floe breaking
68586e03   Jérémy Baudry   new release
53
54
                call ice_fracture
                call statistics
a081b91c   Jérémy Baudry   new
55
                end do
d380ec6c   Jérémy Baudry   second commit
56
        end do
a081b91c   Jérémy Baudry   new
57
!______________________OUTPUTS_________________________________________________
68586e03   Jérémy Baudry   new release
58
        namefile=trim(root)//trim(name_sim)//'/'//trim(name_sim)//'.nc'
c5b6a1a5   Jérémy Baudry   makefile and disp...
59
        call message(6)
a081b91c   Jérémy Baudry   new
60
        call write_output                       ! Write outputs in NETCDF
c5b6a1a5   Jérémy Baudry   makefile and disp...
61
        call message(7)
4e5b4414   Jérémy Baudry   ajout commentaire...
62
63
        
      
81dede1c   Jérémy Baudry   first commit
64
65
66


contains
a081b91c   Jérémy Baudry   new
67
!______________________________________________________________________________
81dede1c   Jérémy Baudry   first commit
68
69
70
subroutine progress(j,jmax)
  implicit none
  integer::j,k,jmax
c5b6a1a5   Jérémy Baudry   makefile and disp...
71
72
73
74
75
76
77
78
79
80
81
  character(len=20)::bar="     processing ???%"
        write(unit=bar(17:19),fmt="(i3)")ceiling((real(j)/real(jmax))*100)
        write(unit=6,fmt="(a1,a22)",advance="no") char(13), bar
        if (real(j)/real(jmax).eq.1) then
        write(unit=6,fmt=*)
        write(*,*)''
        write(*,*)'     simulation completed!'
        write(*,*)''
        write(*,*)'     -------------------------------------------'
        write(*,*)''
        endif
81dede1c   Jérémy Baudry   first commit
82
end subroutine progress
a081b91c   Jérémy Baudry   new
83
!_______________________________________________________________________________
c5b6a1a5   Jérémy Baudry   makefile and disp...
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
subroutine message(info)

        implicit none
        integer,intent(in)::info


        if(info.eq.1) then
        write(*,*)'     ___________________________________________'
        write(*,*)'                  Welcome in WIM'
        write(*,*)'     ___________________________________________'
        write(*,*)''
        end if


        if(info.eq.2) then
        write(*,*)'     Read parameters from namelists...       Done!'
        end if

        if(info.eq.3) then
        write(*,*)'     Allocate memory...                      Done!'
        end if

        if(info.eq.4) then
        write(*,*)'     Initialize arrays and variables...      Done!'
        write(*,*)''
        write(*,*)'     --------------------------------------------'
        write(*,*)''
        end if

         if(info.eq.5) then
        write(*,*)'     Time loop starting...'
        write(*,*)''
        end if

        if(info.eq.6) then
        write(*,*)'     Writing NETCDF output file...'
        write(*,*)''
        end if

        if(info.eq.7) then
        write(*,*)'     Done!'
        write(*,*)''
        end if

        






        
end subroutine message
!_______________________________________________________________________________

81dede1c   Jérémy Baudry   first commit
139
140

END PROGRAM WIM2