Discussion :

[peuf23]

Bonjour,

J'essaie de compiler un programme en fortran avec le compilateur xlf (Je suis sous mac 10.4). La compilation se passe bien, sauf qu'il lui manque 3 subroutines appelées fparm, get_opt et check_opt. Le programme était à l'origine compilé sous SUN, mais j'essaie de le porter sur mon mac.

J'ai bien vérifié dans les autres *.f et librairie, mais aucun ne contient ces subroutines.

Une recherche google ne m'en apprend pas plus. Savez vous plus sur ces routines? le Savez vous où je peux les trouver? Sont-elles remplaçables?

Merci d'avance

Voici le code fortran

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
 
      program ttimes
      save
      parameter (max=60)
      logical log,prnt(3)
      character*8 phcd(max),phlst(10)
      character*80 modnam
      dimension tt(max),dtdd(max),dtdh(max),dddp(max),mn(max),ts(max)
      dimension usrc(2)
      character*2 opt(10)
      character*80 opt_set(10),file
      character*6 stn
      integer nopt, i, inputlu, outputlu
      logical check_opt
      character*80 get_opt
 
      data opt/'+i','+o','+m','?','+p','-l',4*' '/,nopt/6/
      data opt_set/10*' '/
 
      data in/1/,phlst(1)/'ALL'/,prnt(3)/.false./
      data modnam/'/signals/public/trt_tab/iasp91'/ 
c
      call fparm(opt,nopt,opt_set,file,1,i)
 
      if(check_opt(opt,opt_set,nopt,'?')) then
      write(6,*) 'This routine for calculating travel times for'
      write(6,*) 'specific distances uses a set of precalculated'
      write(6,*) 'tau-p tables for the iasp91 model stored as'
      write(6,*) ' iasp91.hed, iasp91.tbl'
      write(6,*)
 
      write(6,*) 'The source depth has to be specified and also'
      write(6,*) 'the phase codes or keywords for the required branches'
      write(6,*) 'ALL will give all available branches'
      write(6,*) 'P  gives P-up,P,Pdiff,PKP, and PKiKP'
      write(6,*) 'P+ gives P-up,P,Pdiff,PKP,PKiKP,PcP,pP,pPdiff,pPKP,' 
      write(6,*) '         pPKiKP,sP,sPdiff,sPKP, and sPKiKP'
      write(6,*) 'S  gives S-up,S,Sdiff, and SKS'
      write(6,*) 'S+ gives S-up,S,Sdiff,SKS,sS,sSdiff,sSKS,pS,pSdiff,'
      write(6,*) '         and pSKS '
      write(6,*) 'BASIC gives P+ and S+ as well as '
      write(6,*) '         ScP, SKP, PKKP, SKKP, PP, and PKPPKP '
      write(6,*)
      write(6,*) 'or give a generic phase name'
      write(6,*)
      write(6,*) 'You will have to enter a distance,'
      write(6,*) 'if this is negative a new depth is calculated'
      write(6,*) 'TO EXIT: give negative depth'
      write(6,*)
      write(6,*) 'RUNSTRING PARAMETERS:'
      write(6,*) '====================='
      write(6,*) '+i fname	parameter input file'
      write(6,*) '		format:'
      write(6,*) '		xxxxxx (depth [km] )'
      write(6,*) '		stname	yyyy (name delta[deg])'
      write(6,*) '		repeat previous line'
      write(6,*) '+o fname	parameter output file'
      write(6,*) '+m model	special model file'
      write(6,*) '		default: /signals/public/trt_tab/iasp91'
      write(6,*) '+p phase	phase is one of the above types'
      write(6,*) '-l 		list possible phases'
      stop
      endif
      if(check_opt(opt,opt_set,nopt,'+i')) then
      	inputlu=55
	file= get_opt(opt,opt_set,nopt,'+i')
	call assign(inputlu,1,file)
      else
      	inputlu= 5
      endif
      if(check_opt(opt,opt_set,nopt,'+o')) then
      	outputlu=66
	file= get_opt(opt,opt_set,nopt,'+o')
	call assign(outputlu,2,file)
      else
      	outputlu= 6
      endif
      if(check_opt(opt,opt_set,nopt,'+m')) then
	modnam= get_opt(opt,opt_set,nopt,'+m')
      endif
      if(check_opt(opt,opt_set,nopt,'-l')) then
	prnt(3)= .true.
      endif
      if(check_opt(opt,opt_set,nopt,'+p')) then
	phlst(1)= get_opt(opt,opt_set,nopt,'+p')
      endif
      prnt(1) = .false.
      prnt(2) = .false.
      call assign(10,2,'ttim1.lis')
      call tabin(in,modnam)
      call brnset(1,phlst,prnt,outputlu)
c                                    choose source depth
 3    if(inputlu.eq.5) call query('Source depth (km):',log)
      read(inputlu,*)zs
      if(zs.lt.0.) go to 13
      call depset(zs,usrc)
c                                    loop on delta
 1    if(inputlu.eq.5) then
 	write(*,*)
      	call query('Enter delta:',log)
        read(inputlu,*)delta
        if(delta.lt.0.) go to 3
      else
      	read(inputlu,*,end=13,err=13) stn, delta
	write(outputlu,'(" station: ",a)') stn
      endif
      write(outputlu,'(" delta:",f7.2," depth:",f7.2)') delta,zs
      write(outputlu,'(2a)')
     %'    # code       time(s)    (min s)    dT/dD',
     %'     dT/dh      d2T/dD2'
      call trtm(delta,max,n,tt,dtdd,dtdh,dddp,phcd)
      if(n.le.0) go to 2
      do 4 i=1,n
        mn(i)=int(tt(i)/60.)
        ts(i)=amod(tt(i),60.)
 4    continue
c
      write(outputlu,100) (i,phcd(i),tt(i),mn(i),ts(i),
     1 dtdd(i),dtdh(i),dddp(i),i=1,n)
 100  format(i5,2x,a,0pf9.2,i4,f7.2,f11.4,1p2e11.2)
      go to 1
 2    write(outputlu,101)delta
 101  format(/1x,'No arrivals for delta =',f7.2)
      go to 1
c                                    end delta loop
 13   call retrns(in)
      call retrns(10)
      if(outputlu.ne.6) call retrns(outputlu)
      call exit(0)
      end
      subroutine asnag1(lu,mode,n,ia,ib)
c
c $$$$$ calls assign, iargc, and getarg $$$$$
c
c   Asnag1 assigns logical unit lu to a direct access disk file
c   with mode "mode" and record length "len".  See dasign for
c   details.  The n th argument is used as the model name.  If there
c   is no n th argument and ib is non-blank, it is taken to be the
c   model name.  If ib is blank, the user is prompted for the
c   model name using the character string in variable ia as the
c   prompt.  Programmed on 8 October 1980 by R. Buland.
c
      save
      logical log
      character*(*) ia,ib
c..................
c all argument parameters are set and treated in the main
c porgram. if a different model was chosen it is allready
c conatine in the array ib.
c
c      integer iargc
c
c     if(iargc(i).lt.n) go to 1
c      if(iargc( )-1.lt.n) go to 1	!no argument on HP-UX m.b
c      					!on SUN iargc starts with 0
c      					!on HP  iargc starts with 1
c      call getarg(n,ib)
c      go to 2
c
c 1    if(ib.ne.' ') go to 2
c      call query(ia,log)
c      read(*,100)ib
c 100  format(a)
c
 2    nb=index(ib,' ')-1
      if(nb.le.0) nb=len(ib)
      call assign(lu,mode,ib(1:nb)//'.hed')
      return
      end

[mipicard]

Regardes si ton compilateur possède la fonction getarg qui fait l'équivalent de fparm. Ensuite il faudra que tu traites les arguments de la ligne de commande "à la main".

[genteur slayer]

ce sont des routines qui "traite" les paramètres que tu passe au prgramme via la ligne de commande, dans la norme fortran, ces fonctions n'existe pas et sont donc des extenssion gérés par le compilateur...

ce qui veut dire que si tu change de compilateur, ces fonctions risque fort d'être différentes voir de ne pas existé du tout...

je ne connais pas le fonctionnement de xlf donc ma suggestion: potasse le manuel de ce compilo, généralement y sont listé les fonctions spécifique et tu trouvera sûrement ton bonheur si elles existent