summaryrefslogtreecommitdiff
path: root/Trivac/src/KTRDRV.f
blob: f957fb13f7dffc9da750a82f4b417a978819e2e9 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
*DECK KTRDRV
      INTEGER FUNCTION KTRDRV(HMODUL,NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
*
*-----------------------------------------------------------------------
*
*Purpose:
* Code dependent operator driver for TRIVAC.
*
*Copyright:
* Copyright (C) 2002 Ecole Polytechnique de Montreal
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2.1 of the License, or (at your option) any later version
*
*Author(s): A. Hebert
*
*Parameters: input/output
* HMODUL  name of the operator.
* NENTRY  number of LCM objects or files used by the operator.
* HENTRY  name of each LCM object or file.
* IENTRY  type of each LCM object or file:
*         =1 LCM memory object; =2 XSM file; =3 sequential binary file;
*         =4 sequential ascii file.
* JENTRY  access of each LCM object or file:
*         =0 the LCM object or file is created;
*         =1 the LCM object or file is open for modifications;
*         =2 the LCM object or file is open in read-only mode.
* KENTRY  LCM object address or file unit number.
*
*Parameters: output
* KTRDRV  completion flag (=0: operator HMODUL exists; =1: does not
*         exists).
*
*-----------------------------------------------------------------------
*
      USE GANLIB
*----
*  SUBROUTINE ARGUMENTS
*----
      CHARACTER HMODUL*(*),HENTRY(NENTRY)*12
      INTEGER IENTRY(NENTRY),JENTRY(NENTRY)
      TYPE(C_PTR) KENTRY(NENTRY)
*----
*  LOCAL VARIABLES
*----
      REAL TBEG,TEND
      DOUBLE PRECISION DMEMB,DMEMD
      LOGICAL :: TRIMOD
*
      KTRDRV=0
      TRIMOD=.TRUE.
      CALL KDRCPU(TBEG)
      CALL KDRMEM(DMEMB)
      IF(HMODUL.EQ.'BIVACA:') THEN
         WRITE(6,'(//7H EXEC: ,A,4H BY ,A)') HMODUL,'A. HEBERT'
         CALL BIVACA(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
      ELSE IF(HMODUL.EQ.'BIVACT:') THEN
         WRITE(6,'(//7H EXEC: ,A,4H BY ,A)') HMODUL,'A. HEBERT'
         CALL BIVACT(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
      ELSE IF(HMODUL.EQ.'FLUD:') THEN
         WRITE(6,'(//7H EXEC: ,A,4H BY ,A)') HMODUL,'A. HEBERT'
         CALL FLD(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
      ELSE IF(HMODUL.EQ.'GEO:') THEN
         WRITE(6,'(//7H EXEC: ,A,4H BY ,A)') HMODUL,'A. HEBERT'
         CALL GEOD(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
      ELSE IF(HMODUL.EQ.'MAC:') THEN
         WRITE(6,'(//7H EXEC: ,A,4H BY ,A)') HMODUL,'A. HEBERT'
         CALL MACD(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
      ELSE IF(HMODUL.EQ.'TRIVAT:') THEN
         WRITE(6,'(//7H EXEC: ,A,4H BY ,A)') HMODUL,'A. HEBERT'
         CALL TRIVAT(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
      ELSE IF(HMODUL.EQ.'TRIVAA:') THEN
         WRITE(6,'(//7H EXEC: ,A,4H BY ,A)') HMODUL,'A. HEBERT'
         CALL TRIVAA(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
      ELSE IF(HMODUL.EQ.'OUT:') THEN
         WRITE(6,'(//7H EXEC: ,A,4H BY ,A)') HMODUL,'A. HEBERT'
         CALL OUT(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
      ELSE IF(HMODUL.EQ.'ERROR:') THEN
         WRITE(6,'(//7H EXEC: ,A,4H BY ,A)') HMODUL,'A. HEBERT'
         CALL ERROR(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
      ELSE IF(HMODUL.EQ.'DELTA:') THEN
         WRITE(6,'(//7H EXEC: ,A,4H BY ,A)') HMODUL,'A. HEBERT'
         CALL DELTA(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
      ELSE IF(HMODUL.EQ.'GPTFLU:') THEN
         WRITE(6,'(//7H EXEC: ,A,4H BY ,A)') HMODUL,'A. HEBERT'
         CALL GPTFLU(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
      ELSE IF(HMODUL.EQ.'INIKIN:') THEN
         WRITE(6,'(//7H EXEC: ,A,4H BY ,A)') HMODUL,'D. SEKKI'
         CALL KININI(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
      ELSE IF(HMODUL.EQ.'KINSOL:') THEN
         WRITE(6,'(//7H EXEC: ,A,4H BY ,A)') HMODUL,'D. SEKKI'
         CALL KINSOL(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
      ELSE IF(HMODUL.EQ.'VAL:') THEN
         WRITE(6,'(//7H EXEC: ,A,4H BY ,A)') HMODUL,'R. CHAMBON'
         CALL VAL(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
      ELSE IF(HMODUL.EQ.'NSST:') THEN
         WRITE(6,'(//7H EXEC: ,A,4H BY ,A)') HMODUL,'A. HEBERT'
         CALL NSST(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
      ELSE IF(HMODUL.EQ.'NSSF:') THEN
         WRITE(6,'(//7H EXEC: ,A,4H BY ,A)') HMODUL,'A. HEBERT'
         CALL NSSF(NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
      ELSE
         TRIMOD=.FALSE.
         KTRDRV=GANDRV(HMODUL,NENTRY,HENTRY,IENTRY,JENTRY,KENTRY)
      ENDIF
      IF(TRIMOD)THEN
         CALL KDRCPU(TEND)
         CALL KDRMEM(DMEMD)
         WRITE(6,5000) HMODUL,(TEND-TBEG),REAL(DMEMD-DMEMB)
      ENDIF
      RETURN
*
 5000 FORMAT('-->>MODULE ',A12,': TIME SPENT=',F13.3,' MEMORY USAGE=',
     1 1P,E10.3)
      END