Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

maxico.f90 @ 221

Last change on this file since 221 was 221, checked in by ymipsl, 10 years ago

Creating temporary dynamico/lmdz/saturn branche

File size: 5.5 KB

Line
1	MODULE maxicosa
2	contains
3	SUBROUTINE maxis(f_fl,maxff,minff)
4	USE icosa
5	IMPLICIT NONE
6	INTEGER::i,j,ij,l,ind
7	TYPE(t_field),POINTER::f_fl(:)
8	REAL(rstd),POINTER::fl(:)
9	REAL(rstd)::maxf,minf
10	REAL(rstd),INTENT(OUT)::maxff,minff
11
12	maxff=-1e50
13	minff=1e50
14	DO ind=1,ndomain
15	CALL swap_dimensions(ind)
16	CALL swap_geometry(ind)
17	fl=f_fl(ind)
18	CALL compute_maxis(fl,maxf,minf)
19	maxff=max(maxff,maxf)
20	minff=min(minff,minf)
21	ENDDO
22	END SUBROUTINE maxis
23	!------------------------------------------------------------
24	SUBROUTINE maxiv(f_fu,maxuu,minuu)
25	USE icosa
26	IMPLICIT NONE
27	INTEGER::i,j,ij,l,ind
28	TYPE(t_field),POINTER::f_fu(:)
29	REAL(rstd),POINTER::fu(:,:)
30	REAL(rstd)::maxu,minu
31	REAL(rstd),INTENT(OUT)::maxuu,minuu
32
33	maxuu=-1e50
34	minuu=1e50
35	DO ind=1,ndomain
36	CALL swap_dimensions(ind)
37	CALL swap_geometry(ind)
38	fu=f_fu(ind)
39	CALL compute_maxiv(fu,maxu,minu)
40	maxuu=max(maxuu,maxu)
41	minuu=min(minuu,minu)
42	ENDDO
43	END SUBROUTINE maxiv
44
45	SUBROUTINE errornorms(f_ref,f_sim,norml1,norml2,normlf)
46	USE icosa
47	IMPLICIT NONE
48	INTEGER::i,j,ij,l,ind
49	TYPE(t_field),POINTER::f_ref(:),f_sim(:)
50	REAL(rstd),POINTER::ref(:),sim(:)
51	REAL(rstd),INTENT(OUT)::norml1,norml2,normlf
52	REAL(rstd)::maxf,minf
53	REAL(rstd)::maxff,minff
54
55	norml1 = 0.0 ; norml2 = 0.0 ; normlf = 0.0
56	DO ind=1,ndomain
57	CALL swap_dimensions(ind)
58	CALL swap_geometry(ind)
59	ref=f_ref(ind)
60	sim=f_sim(ind)
61	CALL compute_maxis(sim,maxf,minf)
62	maxff=max(maxff,maxf)
63	minff=min(minff,minf)
64	ENDDO
65	END SUBROUTINE errornorms
66
67	SUBROUTINE compute_maxis(fl,maxf,minf)
68	USE icosa
69	IMPLICIT NONE
70	REAL(rstd),INTENT(IN)::fl(iim*jjm)
71	REAL(rstd),INTENT(OUT)::maxf,minf
72	INTEGER::i,j,ij
73
74	maxf=-1e50
75	minf= 1e50
76	DO j=jj_begin,jj_end
77	DO i=ii_begin,ii_end
78	ij=(j-1)*iim+i
79	IF ( maxf .LT. fl(ij) ) Then
80	maxf = fl(ij)
81	ENDIF
82	IF ( minf .GT. fl(ij) ) Then
83	minf = fl(ij)
84	ENDIF
85	ENDDO
86	ENDDO
87	END SUBROUTINE compute_maxis
88	!------------------------------------------------------
89	SUBROUTINE compute_maxiv(fu,maxu,minu)
90	USE icosa
91	IMPLICIT NONE
92	REAL(rstd),INTENT(IN)::fu(3iimjjm,llm)
93	REAL(rstd),INTENT(OUT)::maxu,minu
94	INTEGER::i,j,ij
95
96	maxu=-1e50
97	minu=1e50
98	DO j=jj_begin-1,jj_end+1
99	DO i=ii_begin-1,ii_end+1
100	ij=(j-1)*iim+i
101	IF ( maxu .LT. fu(ij+u_right,llm) ) Then
102	maxu = fu(ij+u_right,llm)
103	ENDIF
104	IF ( maxu .LT. fu(ij+u_lup,llm) ) Then
105	maxu = fu(ij+u_lup,llm)
106	ENDIF
107	IF ( maxu .LT. fu(ij+u_ldown,llm) ) Then
108	maxu = fu(ij+u_ldown,llm)
109	ENDIF
110	!------------------------------
111	IF ( minu .GT. fu(ij+u_right,llm) ) Then
112	minu = fu(ij+u_right,llm)
113	ENDIF
114	IF ( minu .GT. fu(ij+u_lup,llm) ) Then
115	minu = fu(ij+u_lup,llm)
116	ENDIF
117	IF ( maxu .GT. fu(ij+u_ldown,llm) ) Then
118	minu = fu(ij+u_ldown,llm)
119	ENDIF
120	ENDDO
121	ENDDO
122	END SUBROUTINE compute_maxiv
123	!--------------------------------------------------
124	Subroutine compute_l1(reference,simulated,nrml1)
125	use icosa
126	IMPLICIT NONE
127	REAL(rstd),INTENT(IN)::reference(iim*jjm)
128	REAL(rstd),INTENT(IN)::simulated(iim*jjm)
129	REAL(rstd),INTENT(OUT)::nrml1
130	REAL(rstd) :: temp1,temp2
131	INTEGER::i,j,ij
132
133	temp1 = 0.0 ; temp2 = 0.0
134	nrml1 = 0.0
135	DO j=jj_begin,jj_end
136	DO i=ii_begin,ii_end
137	ij=(j-1)*iim+i
138	temp1 = temp1 + abs(simulated(ij) - reference(ij))*Ai(ij)
139	temp2 = temp2 + abs(reference(ij))*Ai(ij)
140	END DO
141	END DO
142	nrml1 = temp1/temp2
143	END SUBROUTINE compute_l1
144
145	Subroutine compute_l2(reference,simulated,nrml2)
146	use icosa
147	IMPLICIT NONE
148	REAL(rstd),INTENT(IN)::reference(iim*jjm)
149	REAL(rstd),INTENT(IN)::simulated(iim*jjm)
150	REAL(rstd),INTENT(OUT)::nrml2
151	REAL(rstd) :: temp1,temp2
152	INTEGER::i,j,ij
153
154	temp1 = 0.0 ; temp2 = 0.0
155	nrml2 = 0.0
156	DO j=jj_begin,jj_end
157	DO i=ii_begin,ii_end
158	ij=(j-1)*iim+i
159	temp1 = temp1 + (simulated(ij) - reference(ij))(simulated(ij) - reference(ij))Ai(ij)
160	temp2 = temp2 + reference(ij)reference(ij)Ai(ij)
161	END DO
162	END DO
163	temp1 = sqrt(temp1)
164	temp2 = sqrt(temp2)
165	nrml2 = temp1/temp2
166	END SUBROUTINE compute_l2
167
168	Subroutine compute_lf(reference,simulated,nrmlf)
169	use icosa
170	IMPLICIT NONE
171	REAL(rstd),INTENT(IN)::reference(iim*jjm)
172	REAL(rstd),INTENT(IN)::simulated(iim*jjm)
173	REAL(rstd),INTENT(OUT)::nrmlf
174	REAL(rstd):: difference(iim*jjm)
175	REAL(rstd) :: temp1,temp2
176	INTEGER::i,j,ij
177
178	temp1 = 0.0 ; temp2 = 0.0
179	nrmlf = 0.0
180
181	temp1 = maxval(ABS(difference))
182	temp2 = maxval(ABS(reference))
183	nrmlf = temp1/temp2
184	END SUBROUTINE compute_lf
185	!================================================== initial0
186	SUBROUTINE initial0(f_ps,f_phis,f_theta_rhodz,f_u, f_q)
187	USE icosa
188	IMPLICIT NONE
189	TYPE(t_field),POINTER :: f_ps(:)
190	TYPE(t_field),POINTER :: f_phis(:)
191	TYPE(t_field),POINTER :: f_theta_rhodz(:)
192	TYPE(t_field),POINTER :: f_u(:)
193	TYPE(t_field),POINTER :: f_q(:)
194
195	REAL(rstd),POINTER :: ps(:)
196	REAL(rstd),POINTER :: phis(:)
197	REAL(rstd),POINTER :: theta_rhodz(:,:)
198	REAL(rstd),POINTER :: u(:,:)
199	REAL(rstd),POINTER :: q(:,:,:)
200	INTEGER :: ind
201
202	DO ind=1,ndomain
203	CALL swap_dimensions(ind)
204	CALL swap_geometry(ind)
205	ps=f_ps(ind)
206	phis=f_phis(ind)
207	theta_rhodz=f_theta_rhodz(ind)
208	u=f_u(ind)
209	q=f_q(ind)
210	q=0.0
211	ps=0.0
212	phis=0.0
213	theta_rhodz = 0.0
214	u = 0.0
215	ENDDO
216	END SUBROUTINE initial0
217
218	END MODULE maxicosa

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: codes/icosagcm/branches/SATURN_DYNAMICO/ICOSAGCM/src/maxico.f90 @ 221

Download in other formats: