Context Navigation

mat_oper.F @ 414

Last change on this file since 414 was 414, checked in by aslmd, 13 years ago

LMDZ.MARS : NEW NLTE MODEL FROM GRANADA AMIGOS

23/11/11 == FGG + MALV

New parameterization of the NLTE 15 micron cooling. The old parameterization is kept as an option, including or not variable atomic oxygen concentration. A new flag is introduced in callphys.def, nltemodel, to select which parameterization wants to be used (new one, old one with variable [O], or old one with fixed [O], see below). Includes many new subroutines and commons in phymars. Some existing routines are also modified:

-physiq.F. Call to the new subroutine NLTE_leedat in first call. Call to nltecool modified to allow for variable atomic oxygen. Depending on the value of nltemodel, the new subroutine NLTEdlvr09_TCOOL is called instead of nltecool.

-inifis.F. Reading of nltemodel is added.

-callkeys.h Declaration of nltemodel is added.

The following lines should be added to callphys.def (ideally after setting callnlte):

# NLTE 15um scheme to use.
# 0-> Old scheme, static oxygen
# 1-> Old scheme, dynamic oxygen
# 2-> New scheme
nltemodel = 2

A new directory, NLTEDAT, has to be included in datagcm.

Improvements into NLTE NIR heating parameterization to take into account variability with O/CO2 ratio and SZA. A new subroutine, NIR_leedat.F, and a new common, NIRdata.h, are included. A new flag, nircorr, is added in callphys.def, to include or not these corrections. The following files are modified:

-nirco2abs.F: nq and pq are added in the arguments. The corrections factors are interpolated to the GCM grid and included in the clculation. A new subroutine, interpnir, is added at the end of the file.

-physiq.F: Call to NIR_leedat added at first call. Modified call to nirco2abs

-inifis: Reading new flag nircorr.

-callkeys.h: Declaration of nircorr.

The following lines have to be added to callphys.def (ideally after callnirco2):

# NIR NLTE correction for variable SZA and O/CO2?
# matters only if callnirco2=T
# 0-> no correction
# 1-> include correction
nircorr=1

A new data file, NIRcorrection_feb2011.dat, has to be included in datagcm.

Small changes to the molecular diffusion scheme to fix the number of species considered, to avoid problems when compiling with more than 15 tracers (for example, when CH4 is included). Modified subroutines: aeronomars/moldiff.F and aeronomars/moldiffcoeff.F

File size: 18.8 KB

Line
1	c set of subroutines for the cz*.for programs:
2	! subroutine unit(a,n)
3	! subroutine vector(v,cte,n)
4	! subroutine diagop(a,v,n)
5	! subroutine diago(a,v,n) diagonal matrix with v
6	! subroutine dyago(a,v,n) diagonal matrix with inverse of v
7	! subroutine invdiag(a,b,n) inverse of diagonal matrix
8	! subroutine sypvvv(a,b,c,d,n) suma y prod de 3 vectores, muy comun
9	! subroutine sypvmv(v,w,b,u,n) suma y prod de 3 vectores, muy comun
10	! subroutine mulmvv(w,b,u,v,n) prod matriz vector vector
11	! subroutine muymvv(w,b,u,v,n) prod matriz (inv.vector) vector
12	! subroutine samem (a,m,n)
13	! subroutine samemcore (a,m,n,n-2) extract core of matrix
14	! subroutine samemsp (a,m,n)
15	! subroutine samevsp (v,w,n)
16	! subroutine samev (v,w,n)
17	! subroutine samevcore (v,w,n,n-2) extract core of vector
18	! no subroutine operaux (a,n, b,c,d,e, ll,mm,dd,maux1,maux2)
19	! no subroutine invmcore (a,acore,n, dd,ll,mm)
20	! subroutine mulmv(a,b,c,n)
21	! subroutine mulvmv(a,u,b,v,n)
22	! subroutine mulmm(a,b,c,n)
23	! subroutine summm(a,b,c,n)
24	! subroutine resmm(a,b,c,n)
25	! subroutine mulvv(a,b,c,n)
26	! subroutine sumvv(a,b,c,n)
27	! subroutine sumvvv(a,b,c,d,n)
28	! subroutine resvv(a,b,c,n)
29	! subroutine zerom(a,n)
30	! subroutine zeromsp (a,n)
31	! subroutine zero4m(a,b,c,d,n)
32	! subroutine zero4msp(a,b,c,d,n)
33	! subroutine zero3m(a,b,c,n)
34	! subroutine zero3msp(a,b,c,n)
35	! subroutine zero2m(a,b,n)
36	! subroutine zero2msp(a,b,n)
37	! subroutine zerov(a,n)
38	! subroutine zerovdim3(a,n1,n2,n3) ! sustituye a zerojt de cristina
39	! subroutine zero4v(a,b,c,d,n)
40	! subroutine zero3v(a,b,c,n)
41	! subroutine zero2v(a,b,n)
42	! subroutine zerovsp(a,n)
43	! subroutine zero4vsp(a,b,c,d,n)
44	! subroutine zero3vsp(a,b,c,n)
45	! subroutine zero2vsp(a,b,n)
46	!
47	!
48	!
49	! May-05 Sustituimos todos los zerojt de cristina por las subrutinas
50	! genericas zerov***
51	!
52	c ***********************************************************************
53	subroutine unit(a,n)
54	c store the unit value in the diagonal of a
55	c ***********************************************************************
56	real*8 a(n,n)
57	integer n,i,j,k
58	do 1,i=2,n-1
59	do 2,j=2,n-1
60	if(i.eq.j) then
61	a(i,j) = 1.d0
62	else
63	a(i,j)=0.0d0
64	end if
65	2 continue
66	1 continue
67	do k=1,n
68	a(n,k) = 0.0d0
69	a(1,k) = 0.0d0
70	a(k,1) = 0.0d0
71	a(k,n) = 0.0d0
72	end do
73	return
74	end
75
76	! subroutine vector(v,cte,n)
77	c ***********************************************************************
78	subroutine vector(v,cte,n)
79	c build a vector by storing the value cte in all its elements
80	c ***********************************************************************
81	real*8 v(n),cte
82	integer n,i
83	do 1,i=1,n
84	v(i) = cte
85	1 continue
86	return
87	end
88	c ***********************************************************************
89	subroutine diagop(a,v,n)
90	c store the core of v in the diagonal elements of the square matrix a
91	c ***********************************************************************
92	real*8 a(n,n),v(n+2)
93	integer n,i,j,k
94	do 1,i=2,n-1
95	do 2,j=2,n-1
96	if(i.eq.j) then
97	a(i,j) = v(i+1)
98	else
99	a(i,j)=0.0d0
100	end if
101	2 continue
102	1 continue
103	do k=1,n
104	a(n,k) = 0.0d0
105	a(1,k) = 0.0d0
106	a(k,1) = 0.0d0
107	a(k,n) = 0.0d0
108	end do
109	return
110	end
111	c ***********************************************************************
112	subroutine diago(a,v,n)
113	c store the vector v in the diagonal elements of the square matrix a
114	c ***********************************************************************
115	implicit none
116
117	integer n,i,j,k
118	real*8 a(n,n),v(n)
119
120	do 1,i=2,n-1
121	do 2,j=2,n-1
122	if(i.eq.j) then
123	a(i,j) = v(i)
124	else
125	a(i,j)=0.0d0
126	end if
127	2 continue
128	1 continue
129	do k=1,n
130	a(n,k) = 0.0d0
131	a(1,k) = 0.0d0
132	a(k,1) = 0.0d0
133	a(k,n) = 0.0d0
134	end do
135	return
136	end
137	c ***********************************************************************
138	subroutine dyago(a,v,n)
139	c store the inverse of v in the diagonal elements of the square matrix a
140	c ***********************************************************************
141	implicit none
142
143	integer n,i,j,k
144	real*8 a(n,n),v(n)
145
146	do 1,i=2,n-1
147	do 2,j=2,n-1
148	if(i.eq.j) then
149	a(i,j) = 1.d0/v(i)
150	else
151	a(i,j)=0.0d0
152	end if
153	2 continue
154	1 continue
155	do k=1,n
156	a(n,k) = 0.0d0
157	a(1,k) = 0.0d0
158	a(k,1) = 0.0d0
159	a(k,n) = 0.0d0
160	end do
161	return
162	end
163
164	c ***********************************************************************
165	subroutine samem (a,m,n)
166	c store the matrix m in the matrix a
167	c ***********************************************************************
168	real*8 a(n,n),m(n,n)
169	integer n,i,j,k
170	do 1,i=2,n-1
171	do 2,j=2,n-1
172	a(i,j) = m(i,j)
173	2 continue
174	1 continue
175	do k=1,n
176	a(n,k) = 0.0d0
177	a(1,k) = 0.0d0
178	a(k,1) = 0.0d0
179	a(k,n) = 0.0d0
180	end do
181	return
182	end
183	c ***********************************************************************
184	subroutine samemcore (a,b,m,n)
185	c store the matrix m in the matrix a
186	c ***********************************************************************
187	real*8 a(m,m),b(n,n)
188	integer n,i,j,k
189	if ( m.ne.(n-2) ) stop 'Error in dimensions (m.ne.n-2) '
190	do 1,i=2,n-1
191	do 2,j=2,n-1
192	a(i,j) = b(i,j)
193	2 continue
194	1 continue
195	return
196	end
197	c ***********************************************************************
198	subroutine samemsp (a,m,n)
199	c store the matrix m in the matrix a
200	c ***********************************************************************
201	real*4 a(n,n),m(n,n)
202	integer n,i,j,k
203	do 1,i=2,n-1
204	do 2,j=2,n-1
205	a(i,j) = m(i,j)
206	2 continue
207	1 continue
208	do k=1,n
209	a(n,k) = 0.0
210	a(1,k) = 0.0
211	a(k,1) = 0.0
212	a(k,n) = 0.0
213	end do
214	return
215	end
216	c ***********************************************************************
217	subroutine samevsp (v,w,n)
218	c store the vector w in the vector v
219	c ***********************************************************************
220	real*4 v(n),w(n)
221	integer n,i
222	do 1,i=2,n-1
223	v(i) = w(i)
224	1 continue
225	v(1) = 0.0
226	v(n) = 0.0
227	return
228	end
229	c ***********************************************************************
230	subroutine samev (v,w,n)
231	c store the vector w in the vector v
232	c ***********************************************************************
233	real*8 v(n),w(n)
234	integer n,i
235	do 1,i=2,n-1
236	v(i) = w(i)
237	1 continue
238	v(1) = 0.0d0
239	v(n) = 0.0d0
240	return
241	end
242	c ***********************************************************************
243	subroutine samevcore (v,w,m,n)
244	c store the vector w in the vector v
245	c ***********************************************************************
246	real*8 v(m),w(n)
247	integer n,i
248	if (m.ne.(n-2)) stop ' Error in dimensions (m.ne.n-2) '
249	do 1,i=2,n-1
250	v(i) = w(i)
251	1 continue
252	return
253	end
254	!c ***********************************************************************
255	! subroutine operaux (a,n, b,c,d,e, ll,mm,dd,maux1,maux2)
256	!c ***********************************************************************
257	! real*8 a(n,n),b(n,n),c(n,n),d(n,n),e(n,n)
258	! real*8 maux1(n,n),maux2(n,n),ll(n),mm(n),dd
259	! integer n
260	! call mulmm(a,c,e,n)
261	! call unit(maux1,n)
262	! call resmm(maux2,maux1,a,n) ! maux2 = 1 - c e
263	! call mynvdpnd(maux2,n,dd,ll,mm) ! maux2 = 1 / (1-ce)
264	! call mulmm(a,c,d,n)
265	! call resmm(maux1,b,a,n) ! a = b - c d
266	! call mulmm(a,maux2,maux1,n) ! a = cax2 * (b-cd)
267	! return
268	! end
269	!c ***********************************************************************
270	! subroutine invmcore (a,acore,n, dd,ll,mm)
271	!c ***********************************************************************
272	! real*8 a(n,n), acore(n-2,n-2)
273	! real*8 ll(n-2),mm(n-2),dd
274	! integer i,n,j,k
275	!
276	! do i=2,n-1
277	! do j=2,n-1
278	! acore(i-1,j-1) = a(i,j)
279	! end do
280	! end do
281	! call mynvdpnd (acore,n-2,dd,ll,mm)
282	! do i=2,n-1
283	! do j=2,n-1
284	! a(i,j) = acore(i-1,j-1)
285	! end do
286	! end do
287	! do k=1,n
288	! a(1,k) = 0.d0
289	! a(n,k) = 0.d0
290	! a(k,1) = 0.d0
291	! a(k,n) = 0.d0
292	! end do
293	!
294	! return
295	! end
296	c ***********************************************************************
297	subroutine mulmv(a,b,c,n)
298	c do a(i)=b(i,j)*c(j). a, b, and c must be distint
299	c ***********************************************************************
300	implicit none
301
302	integer n,i,j
303	real*8 a(n),b(n,n),c(n),sum
304
305	do 1,i=2,n-1
306	sum=0.0d0
307	do 2,j=2,n-1
308	sum=sum+ (b(i,j)) * (c(j))
309	2 continue
310	a(i)=sum
311	1 continue
312	a(1) = 0.0d0
313	a(n) = 0.0d0
314	return
315	end
316
317
318
319	cc ***********************************************************************
320	subroutine muymmv(w,b,c,v,n)
321	c c(i,j) is diagonall and will be inverted. Let us call Z(i)=c(i,i)^(-1)
322	c Z(i) and v(i) are vectors. multiply first Z(i) and v(i)
323	c them multiply b and the previous product. w(i)=b(i,j)*(Z(j)+v(j))
324	c ***********************************************************************
325	real*8 w(n),b(n,n),c(n,n),v(n), sum
326	integer n,i,j,k
327	do 1,i=2,n-1
328	sum=0.0d0
329	do 2,j=2,n-1
330	sum=sum+ (b(i,j)) * (v(j)/c(j,j))
331	2 continue
332	w(i)=sum
333	1 continue
334	w(1) = 0.0d0
335	w(n) = 0.0d0
336	return
337	end
338	cc ***********************************************************************
339	subroutine muymvv(w,b,u,v,n)
340	c u(i) is to be inverted. Let us call Z=u^(-1)
341	c Z(i) and v(i) are vectors. multiply first Z(i) and v(i)
342	c them multiply b and the previous product. w(i)=b(i,j)*(Z(j)+v(j))
343	c ***********************************************************************
344	real*8 w(n),u(n),b(n,n),v(n), sum
345	integer n,i,j,k
346	do 1,i=2,n-1
347	sum=0.0d0
348	do 2,j=2,n-1
349	sum=sum+ (b(i,j)) * (v(j)/u(j))
350	2 continue
351	w(i)=sum
352	1 continue
353	w(1) = 0.0d0
354	w(n) = 0.0d0
355	return
356	end
357	c ***********************************************************************
358	subroutine mulmvv(w,b,u,v,n)
359	c u(i) and v(i) are vectors. multiply first u(i) and v(i)
360	c them multiply b and the previous product. w(i)=b(i,j)*(u(j)+v(j))
361	c ***********************************************************************
362	real*8 w(n),u(n),b(n,n),v(n), sum
363	integer n,i,j,k
364	do 1,i=2,n-1
365	sum=0.0d0
366	do 2,j=2,n-1
367	sum=sum+ (b(i,j)) * (u(j)+v(j))
368	2 continue
369	w(i)=sum
370	1 continue
371	w(1) = 0.0d0
372	w(n) = 0.0d0
373	return
374	end
375	c ***********************************************************************
376	subroutine mulvmv(a,u,b,v,n)
377	c u(i) and v(i) are vectors. store u(i) and v(i) in the diagonal
378	c elements of square matrixes. then do a(i,j)= u(i,i)b(i,j)v(j,j)
379	c ***********************************************************************
380	real*8 a(n,n),u(n),b(n,n),v(n)
381	integer n,i,j,k
382	do i=2,n-1
383	do j=2,n-1
384	a(i,j)=(b(i,j)) * (v(j))
385	end do
386	end do
387	do i=2,n-1
388	do j=2,n-1
389	a(i,j)=(u(i)) * (a(i,j))
390	end do
391	end do
392	do k=1,n
393	a(1,k) = 0.d0
394	a(n,k) = 0.d0
395	a(k,1) = 0.d0
396	a(k,n) = 0.d0
397	end do
398
399	return
400	end
401	c ***********************************************************************
402	subroutine mulmm(a,b,c,n)
403	c ***********************************************************************
404	real*8 a(n,n), b(n,n), c(n,n)
405	integer n,i,j,k
406
407	! do i=2,n-1
408	! do j=2,n-1
409	! a(i,j)= 0.d00
410	! do k=2,n-1
411	! a(i,j) = a(i,j) + b(i,k) * c(k,j)
412	! end do
413	! end do
414	! end do
415	do j=2,n-1
416	do i=2,n-1
417	a(i,j)=0.d0
418	enddo
419	do k=2,n-1
420	do i=2,n-1
421	a(i,j)=a(i,j)+b(i,k)*c(k,j)
422	enddo
423	enddo
424	enddo
425	do k=1,n
426	a(n,k) = 0.0d0
427	a(1,k) = 0.0d0
428	a(k,1) = 0.0d0
429	a(k,n) = 0.0d0
430	end do
431
432	return
433	end
434	c ***********************************************************************
435	subroutine summm(a,b,c,n)
436	c ***********************************************************************
437	real*8 a(n,n), b(n,n), c(n,n)
438	integer n,i,j,k
439
440	do i=2,n-1
441	do j=2,n-1
442	a(i,j)= b(i,j) + c(i,j)
443	end do
444	end do
445	do k=1,n
446	a(n,k) = 0.0d0
447	a(1,k) = 0.0d0
448	a(k,1) = 0.0d0
449	a(k,n) = 0.0d0
450	end do
451
452	return
453	end
454	c ***********************************************************************
455	subroutine resmm(a,b,c,n)
456	c ***********************************************************************
457	real*8 a(n,n), b(n,n), c(n,n)
458	integer n,i,j,k
459
460	do i=2,n-1
461	do j=2,n-1
462	a(i,j)= b(i,j) - c(i,j)
463	end do
464	end do
465	do k=1,n
466	a(n,k) = 0.0d0
467	a(1,k) = 0.0d0
468	a(k,1) = 0.0d0
469	a(k,n) = 0.0d0
470	end do
471
472	return
473	end
474	c ***********************************************************************
475	subroutine mulvv(a,b,c,n)
476	c a(i)=b(i)*c(i)
477	c ***********************************************************************
478	real*8 a(n),b(n),c(n)
479	integer n,i
480	do 1,i=2,n-1
481	a(i)= (b(i)) * (c(i))
482	1 continue
483	a(1) = 0.0d0
484	a(n) = 0.0d0
485	return
486	end
487	c ***********************************************************************
488	subroutine sumvv(a,b,c,n)
489	c a(i)=b(i)+c(i)
490	c ***********************************************************************
491	implicit none
492
493	integer n,i
494	real*8 a(n),b(n),c(n)
495
496	do 1,i=2,n-1
497	a(i)= (b(i)) + (c(i))
498	1 continue
499	a(1) = 0.0d0
500	a(n) = 0.0d0
501	return
502	end
503
504	c ***********************************************************************
505	subroutine sumvvv(a,b,c,d,n)
506	c a(i)=b(i)+c(i)+d(i)
507	c ***********************************************************************
508	real*8 a(n),b(n),c(n),d(n)
509	integer n,i
510	do 1,i=2,n-1
511	a(i)= b(i) + c(i) + d(i)
512	1 continue
513	a(1) = 0.0d0
514	a(n) = 0.0d0
515	return
516	end
517	c ***********************************************************************
518	subroutine resvv(a,b,c,n)
519	c a(i)=b(i)-c(i)
520	c ***********************************************************************
521	real*8 a(n),b(n),c(n)
522	integer n,i
523	do 1,i=2,n-1
524	a(i)= (b(i)) - (c(i))
525	1 continue
526	a(1) = 0.0d0
527	a(n) = 0.0d0
528	return
529	end
530	c ***********************************************************************
531	subroutine zerom(a,n)
532	c a(i,j)= 0.0
533	c ***********************************************************************
534
535	implicit none
536
537	integer n,i,j
538	real*8 a(n,n)
539
540	do 1,i=1,n
541	do 2,j=1,n
542	a(i,j) = 0.0d0
543	2 continue
544	1 continue
545	return
546	end
547	c ***********************************************************************
548	subroutine zeromsp (a,n)
549	c a(i,j)= 0.0
550	c ***********************************************************************
551	real*4 a(n,n)
552	integer n,i,j
553	do 1,i=1,n
554	do 2,j=1,n
555	a(i,j) = 0.0
556	2 continue
557	1 continue
558	return
559	end
560	c ***********************************************************************
561	subroutine zero4m(a,b,c,d,n)
562	c a(i,j) = b(i,j) = c(i,j) = d(i,j) = 0.0
563	c ***********************************************************************
564	real*8 a(n,n), b(n,n), c(n,n), d(n,n)
565	integer n,i,j
566	do 1,i=1,n
567	do 2,j=1,n
568	a(i,j) = 0.0d0
569	b(i,j) = 0.0d0
570	c(i,j) = 0.0d0
571	d(i,j) = 0.0d0
572	2 continue
573	1 continue
574	return
575	end
576	c ***********************************************************************
577	subroutine zero4msp(a,b,c,d,n)
578	c a(i,j) = b(i,j) = c(i,j) = d(i,j) = 0.0
579	c ***********************************************************************
580	real*4 a(n,n), b(n,n), c(n,n), d(n,n)
581	integer n,i,j
582	do 1,i=1,n
583	do 2,j=1,n
584	a(i,j) = 0.0
585	b(i,j) = 0.0
586	c(i,j) = 0.0
587	d(i,j) = 0.0
588	2 continue
589	1 continue
590	return
591	end
592	c ***********************************************************************
593	subroutine zero3m(a,b,c,n)
594	c a(i,j) = b(i,j) = c(i,j) = 0.0
595	c **********************************************************************
596	real*8 a(n,n), b(n,n), c(n,n)
597	integer n,i,j
598	do 1,i=1,n
599	do 2,j=1,n
600	a(i,j) = 0.0d0
601	b(i,j) = 0.0d0
602	c(i,j) = 0.0d0
603	2 continue
604	1 continue
605	return
606	end
607	c ***********************************************************************
608	subroutine zero3msp(a,b,c,n)
609	c a(i,j) = b(i,j) = c(i,j) = 0.0
610	c ***********************************************************************
611	real*4 a(n,n), b(n,n), c(n,n)
612	integer n,i,j
613	do 1,i=1,n
614	do 2,j=1,n
615	a(i,j) = 0.0
616	b(i,j) = 0.0
617	c(i,j) = 0.0
618	2 continue
619	1 continue
620	return
621	end
622	c ***********************************************************************
623	subroutine zero2m(a,b,n)
624	c a(i,j) = b(i,j) = 0.0
625	c ***********************************************************************
626	real*8 a(n,n), b(n,n)
627	integer n,i,j
628	do 1,i=1,n
629	do 2,j=1,n
630	a(i,j) = 0.0d0
631	b(i,j) = 0.0d0
632	2 continue
633	1 continue
634	return
635	end
636	c ***********************************************************************
637	subroutine zero2msp(a,b,n)
638	c a(i,j) = b(i,j) = 0.0
639	c ***********************************************************************
640	real*4 a(n,n), b(n,n)
641	integer n,i,j
642	do 1,i=1,n
643	do 2,j=1,n
644	a(i,j) = 0.0
645	b(i,j) = 0.0
646	2 continue
647	1 continue
648	return
649	end
650	c ***********************************************************************
651	subroutine zerov(a,n)
652	c a(i)= 0.0
653	c ***********************************************************************
654	real*8 a(n)
655	integer n,i
656	do 1,i=1,n
657	a(i) = 0.0d0
658	1 continue
659	return
660	end
661	c ***********************************************************************
662	subroutine zero4v(a,b,c,d,n)
663	c a(i) = b(i) = c(i) = d(i,j) = 0.0
664	c ***********************************************************************
665	real*8 a(n), b(n), c(n), d(n)
666	integer n,i
667	do 1,i=1,n
668	a(i) = 0.0d0
669	b(i) = 0.0d0
670	c(i) = 0.0d0
671	d(i) = 0.0d0
672	1 continue
673	return
674	end
675	c ***********************************************************************
676	subroutine zero3v(a,b,c,n)
677	c a(i) = b(i) = c(i) = 0.0
678	c ***********************************************************************
679	real*8 a(n), b(n), c(n)
680	integer n,i
681	do 1,i=1,n
682	a(i) = 0.0d0
683	b(i) = 0.0d0
684	c(i) = 0.0d0
685	1 continue
686	return
687	end
688	c ***********************************************************************
689	subroutine zero2v(a,b,n)
690	c a(i) = b(i) = 0.0
691	c ***********************************************************************
692	real*8 a(n), b(n)
693	integer n,i
694	do 1,i=1,n
695	a(i) = 0.0d0
696	b(i) = 0.0d0
697	1 continue
698	return
699	end
700	c ***********************************************************************
701	subroutine zerovsp(a,n)
702	c a(i)= 0.0
703	c ***********************************************************************
704	real*4 a(n)
705	integer n,i
706	do 1,i=1,n
707	a(i) = 0.0
708	1 continue
709	return
710	end
711	c ***********************************************************************
712	subroutine zero4vsp(a,b,c,d,n)
713	c a(i) = b(i) = c(i) = d(i) = 0.0
714	c ***********************************************************************
715	real*4 a(n), b(n), c(n), d(n)
716	integer n,i
717	do 1,i=1,n
718	a(i) = 0.0
719	b(i) = 0.0
720	c(i) = 0.0
721	d(i) = 0.0
722	1 continue
723	return
724	end
725	c ***********************************************************************
726	subroutine zero3vsp(a,b,c,n)
727	c a(i) = b(i) = c(i) = 0.0
728	c **********************************************************************
729	real*4 a(n), b(n), c(n)
730	integer n,i
731	do 1,i=1,n
732	a(i) = 0.0
733	b(i) = 0.0
734	c(i) = 0.0
735	1 continue
736	return
737	end
738	c ***********************************************************************
739	subroutine zero2vsp(a,b,n)
740	c a(i) = b(i) = 0.0
741	c ***********************************************************************
742	real*4 a(n), b(n)
743	integer n,i
744	do 1,i=1,n
745	a(i) = 0.0
746	b(i) = 0.0
747	1 continue
748	return
749	end
750	c ***********************************************************************
751	!subroutine zerojt(a,n1,n2,n3)
752	subroutine zerovdim3(a,n1,n2,n3) ! sustituye a zerojt de cristina
753	c a(i,j,k)= 0.0
754	c jt(icol,nisos,nb+1,n)
755	c ***********************************************************************
756	! real*4 a(9,34,n)
757	! integer n,i,j,k,icol,ic
758	real*4 a(n1,n2,n3)
759	integer n1,n2,n3,i,j,k
760
761	do 2,i=1,n1
762	do 3,j=1,n2
763	do 4,k=1,n3
764	a(i,j,k) = 0.0
765	4 continue
766	3 continue
767	2 continue
768
769	return
770	end
771	c ***********************************************************************

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

Download in other formats:

Original Format