source: codes/icosagcm/trunk/src/icosagcm.f90 @ 348

Last change on this file since 348 was 348, checked in by dubos, 9 years ago

Forgot to add new files
File size: 2.2 KB
Line 
1MODULE icosa_init_mod
2
3
4
5CONTAINS
6
7  SUBROUTINE icosa_init
8  USE icosa
9  USE timeloop_gcm_mod
10  USE disvert_mod
11  USE etat0_mod
12  USE wind_mod
13  USE mpipara
14  USE omp_para
15  USE vertical_interp_mod
16  USE trace
17  USE output_field_mod
18  USE xios_mod
19  USE write_field_mod
20  USE physics_mod
21  IMPLICIT NONE
22 
23    CALL init_mpipara
24    CALL trace_off
25    CALL xios_init
26    CALL init_earth_const 
27    CALL init_grid_param(is_mpi_master)
28    CALL init_omp_para(is_mpi_master)
29    CALL compute_metric
30    CALL compute_domain
31    CALL init_transfert
32    CALL init_writefield
33    CALL init_trace
34
35  !$OMP PARALLEL 
36    CALL switch_omp_no_distrib_level
37    CALL compute_geometry
38    CALL check_total_area
39 
40    CALL init_disvert 
41    CALL init_vertical_interp
42
43    CALL WriteField("Ai",geom%Ai)
44 
45    IF (is_mpi_root) CALL write_apbp
46    CALL init_time
47
48    CALL output_field_init
49    CALL init_timeloop
50  !$OMP END PARALLEL
51 
52    CALL init_physics
53   
54  !$OMP PARALLEL 
55    CALL timeloop
56    CALL switch_omp_no_distrib_level
57  !$OMP END PARALLEL
58
59    CALL output_field_finalize
60    CALL close_files
61    CALL close_time_counter
62    CALL finalize_mpipara
63
64  CONTAINS
65 
66    SUBROUTINE check_total_area
67    IMPLICIT NONE
68    TYPE(t_field),POINTER,SAVE :: sum_ne(:)
69    TYPE(t_field),POINTER,SAVE :: sum_ne_glo(:)
70    REAL(rstd),POINTER :: pt_sum_ne(:)
71    INTEGER :: ind,i,j,k,n
72    REAL(rstd) :: vect(3,6)
73    REAL(rstd) :: centr(3),dist   
74    REAL(rstd) :: tot_sum=0
75
76      CALL allocate_field(sum_ne,field_T,type_real)
77   
78    !$OMP BARRIER
79    !$OMP MASTER
80      DO ind=1,ndomain
81       
82        pt_sum_ne=sum_ne(ind)
83       
84        CALL swap_dimensions(ind)
85        CALL swap_geometry(ind)
86       
87        DO j=jj_begin,jj_end
88          DO i=ii_begin,ii_end
89            n=(j-1)*iim+i
90            pt_sum_ne(n)=0
91            DO k=1,6
92              pt_sum_ne(n)=pt_sum_ne(n)+ne(n,k)
93            ENDDO
94            IF (domain(ind)%own(i,j)) tot_sum=tot_sum+Ai(n)
95          ENDDO
96        ENDDO
97      ENDDO
98   
99      IF (is_mpi_root) PRINT *," Diff surf",1-tot_sum/(4*Pi*radius*radius)
100    !$OMP END MASTER
101   
102    END SUBROUTINE check_total_area
103 
104  END SUBROUTINE icosa_init
105
106END MODULE icosa_init_mod
Note: See TracBrowser for help on using the repository browser.