1 |
|
|
MODULE etat0_limit_unstruct_mod |
2 |
|
|
|
3 |
|
|
LOGICAL, SAVE :: create_etat0_limit |
4 |
|
|
!$OMP THREADPRIVATE(create_etat0_limit) |
5 |
|
|
|
6 |
|
|
|
7 |
|
|
|
8 |
|
|
|
9 |
|
|
CONTAINS |
10 |
|
|
|
11 |
|
1 |
SUBROUTINE init_etat0_limit_unstruct |
12 |
|
|
#ifdef CPP_XIOS |
13 |
|
|
USE xios, ONLY: xios_set_axis_attr, xios_set_fieldgroup_attr, & |
14 |
|
|
xios_set_filegroup_attr, xios_set_file_attr |
15 |
|
|
USE mod_phys_lmdz_para, ONLY: is_omp_master |
16 |
|
|
USE mod_grid_phy_lmdz, ONLY: grid_type, unstructured |
17 |
|
|
USE ioipsl, ONLY : ioget_year_len |
18 |
|
|
USE ioipsl_getin_p_mod, ONLY: getin_p |
19 |
|
|
USE time_phylmdz_mod, ONLY : annee_ref |
20 |
|
|
USE create_etat0_unstruct_mod, ONLY: init_create_etat0_unstruct |
21 |
|
|
IMPLICIT NONE |
22 |
|
|
|
23 |
|
|
INTEGER :: iflag_phys,i |
24 |
|
|
INTEGER :: ndays |
25 |
|
|
REAL,ALLOCATABLE :: value(:) |
26 |
|
|
|
27 |
|
|
IF (grid_type==unstructured) THEN |
28 |
|
|
CALL getin_p("iflag_phys",iflag_phys) |
29 |
|
|
|
30 |
|
|
CALL getin_p('create_etat0_limit',create_etat0_limit) |
31 |
|
|
|
32 |
|
|
ndays=ioget_year_len(annee_ref) |
33 |
|
|
ALLOCATE(value(ndays)) |
34 |
|
|
DO i=1,ndays |
35 |
|
|
value(i)=i-1 |
36 |
|
|
ENDDO |
37 |
|
|
|
38 |
|
|
IF (is_omp_master) CALL xios_set_axis_attr("time_year",n_glo=ndays,value=value) |
39 |
|
|
|
40 |
|
|
IF (create_etat0_limit) THEN |
41 |
|
|
IF (iflag_phys<100) THEN |
42 |
|
|
IF (is_omp_master) CALL xios_set_fieldgroup_attr("etat0_limit_read",read_access=.TRUE.,enabled=.TRUE.) |
43 |
|
|
IF (is_omp_master) CALL xios_set_filegroup_attr("etat0_limit_read",enabled=.TRUE.) |
44 |
|
|
ENDIF |
45 |
|
|
IF (is_omp_master) CALL xios_set_file_attr("limit_write",enabled=.TRUE.) |
46 |
|
|
CALL init_create_etat0_unstruct |
47 |
|
|
ENDIF |
48 |
|
|
|
49 |
|
|
ENDIF |
50 |
|
|
|
51 |
|
|
#endif |
52 |
|
1 |
END SUBROUTINE init_etat0_limit_unstruct |
53 |
|
|
|
54 |
|
1 |
SUBROUTINE create_etat0_limit_unstruct |
55 |
|
|
#ifdef CPP_XIOS |
56 |
|
|
USE mod_grid_phy_lmdz, ONLY: grid_type, unstructured |
57 |
|
|
USE create_etat0_unstruct_mod, ONLY: create_etat0_unstruct |
58 |
|
|
USE create_limit_unstruct_mod, ONLY: create_limit_unstruct |
59 |
|
|
USE phyaqua_mod, ONLY: iniaqua |
60 |
|
|
USE phys_cal_mod, only: year_len |
61 |
|
|
USE mod_phys_lmdz_para, ONLY: is_omp_master |
62 |
|
|
USE ioipsl_getin_p_mod, ONLY: getin_p |
63 |
|
|
USE dimphy, ONLY: klon |
64 |
|
|
USE xios, ONLY: xios_context_finalize, xios_set_current_context, & |
65 |
|
|
xios_finalize |
66 |
|
|
USE print_control_mod, ONLY: lunout |
67 |
|
|
IMPLICIT NONE |
68 |
|
|
INTEGER :: iflag_phys |
69 |
|
|
INTEGER :: ierr |
70 |
|
|
CHARACTER (LEN=20) :: modname='create_etat0_limit_unstruct' |
71 |
|
|
CHARACTER (LEN=80) :: abort_message |
72 |
|
|
|
73 |
|
|
IF (grid_type==unstructured) THEN |
74 |
|
|
|
75 |
|
|
CALL getin_p("iflag_phys",iflag_phys) |
76 |
|
|
|
77 |
|
|
IF (iflag_phys<100) THEN |
78 |
|
|
IF ( create_etat0_limit) THEN |
79 |
|
|
CALL create_etat0_unstruct |
80 |
|
|
CALL create_limit_unstruct |
81 |
|
|
IF (is_omp_master) THEN |
82 |
|
|
CALL xios_context_finalize() |
83 |
|
|
CALL xios_set_current_context("icosagcm") ! very bad, need to find an other solution |
84 |
|
|
CALL xios_context_finalize() |
85 |
|
|
CALL xios_finalize() |
86 |
|
|
#ifdef CPP_MPI |
87 |
|
|
CALL MPI_Finalize(ierr) |
88 |
|
|
#endif |
89 |
|
|
abort_message='create_etat0_limit_unstruct, Initial state file are created, all is fine' |
90 |
|
|
CALL abort_physic(modname,abort_message,0) |
91 |
|
|
ENDIF |
92 |
|
|
!$OMP BARRIER |
93 |
|
|
abort_message='create_etat0_limit_unstruct, Initial state file are created, all is fine' |
94 |
|
|
CALL abort_physic(modname,abort_message,0) |
95 |
|
|
ENDIF |
96 |
|
|
ELSE |
97 |
|
|
IF (create_etat0_limit) THEN |
98 |
|
|
CALL iniaqua(klon,year_len,iflag_phys) |
99 |
|
|
IF (is_omp_master) THEN |
100 |
|
|
CALL xios_context_finalize() |
101 |
|
|
CALL xios_set_current_context("icosagcm") ! very bad, need to find an other solution |
102 |
|
|
CALL xios_context_finalize() |
103 |
|
|
CALL xios_finalize() |
104 |
|
|
#ifdef CPP_MPI |
105 |
|
|
CALL MPI_Finalize(ierr) |
106 |
|
|
#endif |
107 |
|
|
ENDIF |
108 |
|
|
!$OMP BARRIER |
109 |
|
|
abort_message='create_etat0_limit_unstruct, Initial state file are created, all is fine' |
110 |
|
|
CALL abort_physic(modname,abort_message,0) |
111 |
|
|
ENDIF |
112 |
|
|
ENDIF |
113 |
|
|
ENDIF |
114 |
|
|
|
115 |
|
|
#endif |
116 |
|
1 |
END SUBROUTINE create_etat0_limit_unstruct |
117 |
|
|
|
118 |
|
|
END MODULE etat0_limit_unstruct_mod |
119 |
|
|
|