source: codes/icosagcm/trunk/src/maxico.f90 @ 155

Last change on this file since 155 was 149, checked in by sdubey, 11 years ago
Added few new routines to read NC files and compute diagnostics to r145.
Few routines of dry physics including radiation module, surface process and convective adjustment in new routine phyparam.f90. dynetat to read start files for dynamics. check_conserve routine to compute conservation of quatities like mass, energy etc.etat0_heldsz.f90 for held-suarez test case initial conditions. new Key time_style=lmd or dcmip to use day_step, ndays like in LMDZ
File size: 5.5 KB
Line 
1 MODULE maxicosa
2contains
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(3*iim*jjm,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.