source: trunk/LMDZ.GENERIC/libf/dyn3d/diagadv.F @ 374

Last change on this file since 374 was 135, checked in by aslmd, 14 years ago

CHANGEMENT ARBORESCENCE ETAPE 2 -- NON COMPLET

File size: 1.4 KB
RevLine 
[135]1      subroutine diagadv(q,masse,descript)
2      implicit none
3#include "dimensions.h"
4#include "paramet.h"
5#include "comgeom.h"
6      real q(iip1,jjp1,llm),masse(iip1,jjp1,llm)
7      integer i,j,l
8      character*10 descript
9      real sss,smas,smin,smax
10 
11      external ismin,ismax
12      integer ismin,ismax
13 
14      sss=0.
15      smas=0.
16      smin=1.e33
17      smax=-1.e33
18      do l=1,llm
19        do j=1,jjp1
20           do i=1,iim
21              sss=sss+masse(i,j,l)*q(i,j,l)
22              smas=smas+masse(i,j,l)
23              smin=min(smin,q(i,j,l))
24              smax=max(smax,q(i,j,l))
25           enddo
26        enddo
27      enddo
28
29      write(*,1000) descript,smin,smax,sss/smas,sss
30 
31      return
321000  format(a10,'   MIN:',e15.4,'   MAX:',e15.4,'   MOY:',e15.4
33     s   ,'   TOT:',e15.4)
34      end
35
36      FUNCTION ismin(n,sx,incx)
37c
38      IMPLICIT NONE
39c
40      integer n,i,incx,ismin,ix
41      real sx((n-1)*incx+1),sxmin
42c
43      ix=1
44      ismin=1
45      sxmin=sx(1)
46      DO i=1,n-1
47         ix=ix+incx
48         if(sx(ix).lt.sxmin) then
49             sxmin=sx(ix)
50             ismin=i+1
51         endif
52      ENDDO
53c
54      return
55      end
56C
57      function ismax(n,sx,incx)
58c
59      IMPLICIT NONE
60c
61      INTEGER n,i,incx,ismax,ix
62      real sx((n-1)*incx+1),sxmax
63c
64      ix=1
65      ismax=1
66      sxmax=sx(1)
67      do 10 i=1,n-1
68       ix=ix+incx
69       if(sx(ix).gt.sxmax) then
70         sxmax=sx(ix)
71         ismax=i+1
72       endif
7310    continue
74c
75      return
76      end
77
Note: See TracBrowser for help on using the repository browser.