需求
-
- gflie数据结构
-
- e2d脚本
-
- 解决SF三角网格问题
python面向对象编程的基本原则
-
- 构想阶段——考虑步骤，不考虑实现（你能想到的事情，编程语言的库基本都帮你实现）
-
- 实施阶段——逐个完善各个函数的具体实现（易用、参数传递、加深考虑）
-
- 完善阶段——易读性、巧妙的实现方式（漂亮的代码是改出来的）
gfile 内容
- 1. 格式
- 压强
- 极向电流函数
- q剖面（在flux网格和正交网格）
- 等离子体边界和周围限制器等高线
-2. 物理量
- psizr(nw,nh) 正交网格个点的极限流（weber/rad）
- nw径向格点数
- nh高度z的格点数
- fpol(1)极向电流函数在流格点()
- pres(1) 标准流格点等离子体压力（）
- ffprim(1)标准流格点
- pprime(1)标准流格点
- qpsi(1)标准流表面q值（从轴到边界）
- rbbbs(1)径向边界格点位置（m）
- zbbbs(1)垂直边界格点位置（m）
- rlim(1)径向限制器等高线位置（m）
- zlim(1)垂直限制器等高线位置（m）
3. fortran程序
读取程序
-1. constant
- idum产生随机数
- [ ]
- 2. e2d scripts
#! /usr/bin/env ksh
# VERSION : 02.09.99 14:44
# basename: 删除‘/’之前的内容
# $0
Name=`basename $0`
Usage="$Name: EFIT-to-DG format conversion
Usage: $Name EFIT-file DG-file
where DG-file is the output filename,
and EFIT-file is the input filename.
"
[ $# -lt 2 ] && { echo "$Usage"; exit; }
[ -r $1 ] || { echo "File $1 is absent\n"; echo "$Usage"; exit; }
ef2dg $1 $2 $3
ef2dg
00001
00008
[00009](ef2dg_8f.html#ad6c3f68d6f9acae649fe675931437c89) program [ef2dg](ef2dg_8f.html#ad6c3f68d6f9acae649fe675931437c89)
00010 c
00011 c version : 16.11.95 20:04
00012 c
00013 c=====================================================
00014 c*** Translation of efit equilibrium data into dg compatible format
00015 c=====================================================
00016 implicit none
00017 #include "eqdim.inc"
00018 integer iret, nr, nz, ipestg
00019 real(kind=R8) :: fg(ngpr),pg(ngpr),ffg(ngpr),ppg(ngpr)
00020 real(kind=R8) :: pfm(ngpr,ngpz),rgr(ngpr),zgr(ngpz)
00021 real(kind=R8) :: rdim,zdim,rcntc,redge,zmsmid,rma,zma,
00022 & psimin,psilim,btorc
00023 character title*80, date*8
00024 c=====================================================
00025 c # 打开文件夹的相关操作
00026 call [open_files] (open__files_8f.html#aea2224f1a3d84bb57bfbbba13313b32b)(' ')
00027
00028 call [rdefit](rdefit_8f.html#a38787aa99d8d9b30dd5917cc3b6f70ca)(1,iret,title,date,ipestg,nr,nz,
00029 , rdim,zdim,zmsmid,rcntc,redge,rma,zma,psimin,psilim,
00030 , btorc,fg,pg,ffg,ppg,pfm,rgr,zgr)
00031 if(iret.ne.0) then
00032 print *,'==== ef2dg: error in rdefit. iret =',iret
00033 stop
00034 end if
00035 c
00036 print *,'psilim = ',psilim
00037 call [wreqdg](pt2dg_8f.html#adad65bd08d70995527e77cd5d5a6aba2)(2,iret,nr,nz,psilim,btorc,rcntc,rgr,zgr,pfm)
00038 if(iret.ne.0) then
00039 print *,'==== ef2dg: error in wreqdg. iret = ',iret
00040 end if
00041 c
00042 end
* * *
openfiles
00001
[00005](open__files_8f.html#aea2224f1a3d84bb57bfbbba13313b32b) subroutine [open_files](open__files_8f.html#aea2224f1a3d84bb57bfbbba13313b32b)(outstring)
00006
00007 character*256 filename
00008 character*(*) outstring
00009 #ifndef NAGFOR
00010 integer iargc
00011 #else
00012 integer lenval, ierror
00013 #endif
00014
00015 #ifndef NAGFOR
00016 if(iargc().lt.2) then
00017 #else
00018 if(command_argument_count().lt.2) then
00019 #endif
00020 write(*,*) '1st arg == input equilibrium file'
00021 write(*,*) '2nd arg == output equilibrium file'
00022 write(*,*) '3rd arg == btor data [optional]'
00023 if(trim(outstring).ne.trim(' '))
00024 & write(*,*) trim(outstring)
00025 stop
00026 endif
00027
00028 #ifndef NAGFOR
00029 call getarg(1,filename)
00030 open(1,file=filename)
00031 call getarg(2,filename)
00032 open(2,file=filename)
00033 if(iargc().gt.2) then
00034 call getarg(3,filename)
00035 if(filename.ne.'') open(3,file=filename)
00036 endif
00037 #else
00038 call get_command_argument(1,filename,lenval,ierror)
00039 open(1,file=filename)
00040 call get_command_argument(2,filename,lenval,ierror)
00041 open(2,file=filename)
00042 if(command_argument_count().gt.2) then
00043 call get_command_argument(3,filename,lenval,ierror)
00044 if(filename.ne.'') open(3,file=filename)
00045 endif
00046 #endif
00047 return
00048 end
rdefit
[00001](rdefit_8f.html#a38787aa99d8d9b30dd5917cc3b6f70ca) subroutine [rdefit](rdefit_8f.html#a38787aa99d8d9b30dd5917cc3b6f70ca)(lun,iret,title,date,ipestg,nr,nz,
00002 , rdim,zdim,zmsmid,rcntc,redge,rma,zma,psimin,psilim,
00003 , btorc,fg,pg,ffg,ppg,pfm,rgr,zgr)
00004 c=====================================================
00005 c*** where:
00006 c***
00007 c*** i) nr, nz, rdim, redge, and zdim define the rectangular mesh used
00008 c*** to store the psi values via the functions rr & zz defined at
00009 c*** the top of these code,
00010 c***
00011 c*** ii) psimin is the flux value at the magnetic axis; psilim is the
00012 c*** value at the separatrix,
00013 c***
00014 c*** iii) btorc is the toroidal magnetic field at a radius rcntc,
00015 c***
00016 c*** iv) the poloidal flux is pfm,
00017 c***
00018 c*** v) fg is the flux function R*Btor; ffg is its derivative with
00019 c*** respect to psi,
00020 c***
00021 c*** vi) pg is the pressure & ppg is its derivative.
00022 c=====================================================
00023 c
00024 c version : 18.12.94 18:33
00025 c
00026 implicit none
00027 #include "eqdim.inc"
00028 integer lun,iret,ipestg,nr,nz
00029 real(kind=R8) :: fg(*),pg(*),ffg(*),ppg(*),pfm(ngpr,*),
00030 & rgr(*),zgr(*)
00031 real(kind=R8) :: rdim,zdim,rcntc,redge,zmsmid,rma,zma,
00032 & psimin,psilim,btorc
00033 integer i,j,l
00034 character zeile*80, title*80, date*8, cvect(80)*1
00035 c=====================================================
00036 real(kind=R8) :: rr, zz, r, z
00037 rr(r)=r/float(nr-1)*rdim+redge
00038 zz(z)=(z-float(nz+1)/float(2))/float(nz-1)*zdim+zmsmid
00039 c=====================================================
00040 c
00041 iret=0
00042 rewind lun
00043 read(lun,'(a80)') zeile
00044 l=len(trim(zeile))
00045 read(zeile(l-3:l),'(i4)') nz
00046 read(zeile(l-7:l-4),'(i4)') nr
00047 read(zeile(l-11:l-8),'(i4)') ipestg
00048 date=zeile(l-19:l-12)
00049 title=zeile(1:l-20)
00050 write(*,*) ipestg,nr,nz
00051 if(nr.gt.ngpr) then
00052 write (6,'(a,i4,a,i4,a)')
00053 . '=== rdefit: nr (',nr,') > ngpr (',ngpr,')'
00054 iret=2
00055 end if
00056 if(nz.gt.ngpz) then
00057 write (6,'(a,i4,a,i4,a)')
00058 . '=== rdefit: nz (',nz,') > ngpz (',ngpz,')'
00059 iret=2
00060 end if
00061 if(nr.le.0) then
00062 write (6,'(a,i4,a)') '=== rdefit: nr (',nr,') < 1'
00063 iret=4
00064 end if
00065 if(nz.le.0) then
00066 write (6,'(a,i4,a)') '=== rdefit: nz (',nz,') < 1'
00067 iret=4
00068 end if
00069 if(iret.ne.0) return
00070 c
00071 read(lun,'(80a1)',advance='no',size=l) cvect
00072 backspace(lun)
00073 if (l.eq.80) then
00074 read(lun,'(5e16.9)') rdim,zdim,rcntc,redge,zmsmid
00075 else
00076 read(lun,*) rdim,zdim,rcntc,redge,zmsmid
00077 endif
00078 read(lun,'(80a1)',advance='no',size=l) cvect
00079 backspace(lun)
00080 if (l.eq.80) then
00081 read(lun,'(5e16.9)') rma,zma,psimin,psilim,btorc
00082 else
00083 read(lun,*) rma,zma,psimin,psilim,btorc
00084 endif
00085 read(lun,'()')
00086 read(lun,'()')
00087 read(lun,'(5e16.9)') (fg(i),i=1,nr)
00088 read(lun,'(5e16.9)') (pg(i),i=1,nr)
00089 read(lun,'(5e16.9)') (ffg(i),i=1,nr)
00090 read(lun,'(5e16.9)') (ppg(i),i=1,nr)
00091 read(lun,'(5e16.9)') ((pfm(i,j),i=1,nr),j=1,nz)
00092 do i=1,nr
00093 rgr(i)=rr(real(i-1,R8))
00094 enddo
00095 do i=1,nz
00096 zgr(i)=zz(real(i,R8))
00097 enddo
00098 c
00099 end
wrdfeq
00001
00004
[00005](pt2dg_8f.html#a971fe56aa0a720c238b9605d99be12b5) program [pt2dg](pt2dg_8f.html#a971fe56aa0a720c238b9605d99be12b5)
00006
00007 c version : 02.11.2000 23:25
00008 c=======================================================================
00009 c*** Conversion of equilibrium file produced with PROTEUS into DG format
00010 c*** (courtesy Prof. O. de Barbieri)
00011 c=======================================================================
00012 c
00013 implicit none
00014 #include "eqdim.inc"
00015 #include "pt2dg.inc"
00016 c
00017 c-----------------------------------------------------------------------
00018 c
00019 integer lko(6)
00020 logical ex,exi
00021 real(kind=R8) :: psib, btf, rtf
00022 real(kind=R8) :: x1, x2, x3, y1, y2, y3
00023 integer nrnz(2)
00024 integer jr,jz,j1,j110,j120,j100,j23,j22,j21,j50,j49,j29,j20,l20
00025 integer kret,lm,lnwt,lr23,lk22,lk21,kbpol,kwrite
00026 integer lwreqdg,lelem,lnode,lbound,lreg,lcount,lkill,lke
00027 integer modele,mnodes,melems,mhmesh
00028 real(kind=R8) :: rmnmx(2),zmnmx(2),btrt(2)
00029 real(kind=R8) :: zp00,zpz2,zx1e,zy1e,zx2e,zy2e,zxye,zpr1,zpr2,
00030 . zpz1,zarsum,zardif,zr0,zz0,za11,za12,za21,za22,
00031 . zb11,zb12,zb21,zb22,zx0,ze0,zr,zz,zarea,
00032 . zar12,zar13,zar23,zdet,z00e,zdr,zdz,zprz,
00033 . rmin,rmax,zmin,zmax
00034 character*256 in_mesh,in_psi,out_file,hlp_txt*8
00035 namelist/input/nrnz,rmnmx,zmnmx,btrt,in_mesh,in_psi,out_file
00036 data nrnz, rmnmx, zmnmx, btrt, in_mesh, in_psi, out_file /
00037 / 2*0,2*0._R8,2*0._R8,2*0._R8, ' ' , ' ' , ' ' /
00038 c
00039 c -----------------------------------------------
00040 c
00041 c Pre-defined function: double of the area of a triangle
00042 c -------------------
00043 real (kind=R8) :: artri
00044 artri(x1,x2,x3,y1,y2,y3) = abs(x1*(y2-y3)+x2*(y3-y1)+x3*(y1-y2))
00045 c
00046 c-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
00047 c
00048 cank{
00049 c*** Input the parameters
00050 ex=.true.
00051 read(5,input,err=10,end=10)
00052 ex=.false.
00053 10 if(ex) then !{
00054 write(0,*) 'pt2dg: error in the parameter file format.'
00055 write(0,*) ' It must conform to the NAMELIST input.'
00056 stop
00057 end if !}
00058 c read(nparm,*) mpr,mpz,rmin,rmax,zmin,zmax,btf,rtf
00059 c print *,mpr,mpz,rmin,rmax,zmin,zmax,btf,rtf
00060 c*** check the parameters
00061 write(0,*) 'Checking the data from the parameter file'
00062 ex=.false.
00063 if(nrnz(1).le.0 .or. nrnz(2).le.0) then !{
00064 write(0,*) 'nrnz must be positive : ',nrnz
00065 ex=.true.
00066 end if !}
00067 if(rmnmx(1).ge.rmnmx(2)) then !{
00068 write(0,*) 'rmnmx must be ascending: ',rmnmx
00069 ex=.true.
00070 end if !}
00071 if(rmnmx(1).le.0.) then !{
00072 write(0,*) 'rmnmx must be positive: ',rmnmx
00073 ex=.true.
00074 end if !}
00075 if(zmnmx(1).ge.zmnmx(2)) then !{
00076 write(0,*) 'zmnmx must be ascending: ',zmnmx
00077 ex=.true.
00078 end if !}
00079 if(btrt(1).le.0\. .or. btrt(2).le.0.) then !{
00080 write(0,*) 'btrt must be positive : ',btrt
00081 ex=.true.
00082 end if !}
00083 if(in_mesh.eq.' ') then !{
00084 write(0,*) 'in_mesh file must be specified'
00085 ex=.true.
00086 end if !}
00087 if(in_psi.eq.' ') then !{
00088 write(0,*) 'in_psi file must be specified'
00089 ex=.true.
00090 end if !}
00091 if(out_file.eq.' ') then !{
00092 write(0,*) 'out_file file must be specified'
00093 ex=.true.
00094 end if !}
00095 if(ex) then !{
00096 write(0,*) 'Please correct the parameter file!'
00097 stop
00098 end if !}
00099 c*** Assign the parameters and check further
00100 mpr=nrnz(1)
00101 mpz=nrnz(2)
00102 rmin=rmnmx(1)
00103 rmax=rmnmx(2)
00104 zmin=zmnmx(1)
00105 zmax=zmnmx(2)
00106 btf=btrt(1)
00107 rtf=btrt(2)
00108 if(mpr.gt.npr) then !{
00109 ex=.true.
00110 write(0,*) 'mpr > npr : ',mpr,npr
00111 end if !}
00112 if(mpz.gt.npz) then !{
00113 ex=.true.
00114 write(0,*) 'mpz > npz : ',mpz,npz
00115 end if !}
00116 inquire(file=in_mesh, exist=exi)
00117 if(.not.exi) then !{
00118 ex=.true.
00119 write(0,*) 'in_mesh file not found:',in_mesh
00120 end if !}
00121 inquire(file=in_psi, exist=exi)
00122 if(.not.exi) then !{
00123 ex=.true.
00124 write(0,*) 'in_psi file not found:',in_psi
00125 end if !}
00126 if(ex) then !{
00127 write(0,*) 'Please correct the parameter file!'
00128 stop
00129 end if !}
00130 write(0,*) ' - look OK'
00131 c*** Open the files
00132 hlp_txt='in_mesh'
00133 open(nread,file=in_mesh,err=15)
00134 hlp_txt='in_psi'
00135 open(ndisk,file=in_psi,err=15)
00136 hlp_txt='in_psi'
00137 open(nwreqdg,file=out_file,err=15)
00138 ex=.true.
00139 15 if(.not.ex) then !{
00140 write(0,*) 'Failed opening ',hlp_txt
00141 end if !}
00142 cank}
00143 c
00144 c
00145 c The following is the flag for B.pol calculation
00146 c If it is less than zero ----> no B.pol
00147 c -----------------------------------------------
00148 kbpol = 1
00149 c
00150 c
00151 c The following is the flag for standard output
00152 c (without B.pol even if kbpol=1)
00153 c -----------------------------------------------
00154 kwrite =-1
00155 c ++++++
00156 c
00157 if(kwrite.gt.0) then
00158 write(nwrite,2200) npr,npz,mpr,mpz
00159 endif
00160 c
00161 c
00162 c +---------------------------+
00163 c---------------------> | Read mesh from unit NREAD | <---------------
00164 c +---------------------------+
00165 c
00166 read(nread,1003) (cmesht(lm:lm),lm = 1,80)
00167 read(nread,1000) mnodes,melems,mhmesh
00168 if(mnodes.gt.nnodes) then
00169 write(nwrite,1060) mnodes,nnodes
00170 lkill = 1
00171 endif
00172 if(melems.gt.nelems) then
00173 write(nwrite,1070) melems,nelems
00174 lkill = 1
00175 endif
00176 do 100 j100 = 1,mnodes
00177 read(nread,1001) lnode, lbound, zr, zz
00178 rznods(1,lnode) = zr
00179 rznods(2,lnode) = zz
00180 kbound(lnode) = lbound
00181 100 continue
00182 do 120 j120 = 1,melems
00183 read(nread,1002) modele, lelem, keyreg(lelem)
00184 +, (lko(lke),lke=1,modele)
00185 do 110 j110 = 1,6
00186 keynod(j110,lelem) = lko(j110)
00187 110 continue
00188 120 continue
00189 c
00190 c
00191 c
00192 c +--------------------------+
00193 c---------------------> | Read PSI from unit NDISK | <----------------
00194 c +--------------------------+
00195 c
00196 rewind ndisk
00197 read(ndisk,*) ( psi(j1), j1=1,mnodes )
00198 c
00199 c-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
00200 c
00201 c
00202 c +--------------------+
00203 c---------------------> | Quadrilateral mesh | <----------------------
00204 c +--------------------+
00205 c
00206 lcount = 0
00207 zdr = (rmax-rmin)/float(mpr-1)
00208 zdz = (zmax-zmin)/float(mpz-1)
00209 do 500 j50 = 1,mpr
00210 xrp(j50) = rmin + zdr*float(j50-1)
00211 do 490 j49 = 1,mpz
00212 xzp(j49) = zmin + zdz*float(j49-1)
00213 do 290 j29 = 1,melems
00214 do 200 j20 = 1,6
00215 lko(j20) = keynod(j20,j29)
00216 l20 = lko(j20)
00217 pnodr(j20) = rznods(1,l20)
00218 pnodz(j20) = rznods(2,l20)
00219 psiele(j20)= psi(l20)
00220 200 continue
00221 lnwt = -1
00222 lreg = keyreg(j29)
00223 if(lreg.le.-100) then
00224 lnwt = 1
00225 go to 25
00226 endif
00227 do 230 j23 = 1,melems
00228 if(j23.eq.j29) go to 23
00229 lr23 = keyreg(j23)
00230 if(lr23.le.-100.and.
00231 + lreg.eq.0) then
00232 do 220 j22 = 4,6
00233 lk22 = keynod(j22,j23)
00234 do 210 j21 = 4,6
00235 lk21 = keynod(j21,j29)
00236 if(lk21.eq.lk22) then
00237 lnwt = 1
00238 go to 25
00239 endif
00240 210 continue
00241 220 continue
00242 endif
00243 23 continue
00244 230 continue
00245 go to 27
00246 25 continue
00247 if(lnwt.gt.0) then
00248 kel = j29
00249 yrp = xrp(j50)
00250 yzp = xzp(j49)
00251 CALL [TRINWT](pt2dg_8f.html#ab954ece6618d5879ab91cf37b0735a5a)
00252 c -----=====
00253 if(kerror.lt.0) then
00254 psi4(j50,j49) = ypsi
00255 lcount = lcount + 1
00256 c
00257 if(kwrite.gt.0) then
00258 write(nwrite,2300) j50,j49,j29
00259 +, xrp(j50),xzp(j49),psi4(j50,j49)
00260 write(nwrite,2400)
00261 + pnodr(1),pnodr(2),pnodr(3)
00262 +, pnodz(1),pnodz(2),pnodz(3)
00263 +, psiele(1),psiele(2),psiele(3)
00264 write(nwrite,2600) csi,eta
00265 endif
00266 c
00267 go to 49
00268 endif
00269 go to 29
00270 endif
00271 27 continue
00272 kel = j29
00273 yrp = xrp(j50)
00274 yzp = xzp(j49)
00275 zarea = artri(pnodr(1),pnodr(2),pnodr(3),
00276 + pnodz(1),pnodz(2),pnodz(3))
00277 zar12 = artri(pnodr(1),pnodr(2),xrp(j50),
00278 + pnodz(1),pnodz(2),xzp(j49))
00279 zar13 = artri(pnodr(1),xrp(j50),pnodr(3),
00280 + pnodz(1),xzp(j49),pnodz(3))
00281 zar23 = artri(xrp(j50),pnodr(2),pnodr(3),
00282 + xzp(j49),pnodz(2),pnodz(3))
00283 zarsum = zar12 + zar13 + zar23
00284 zardif = abs(zarea - zarsum)
00285 if(zardif.lt.1.e-03) then
00286 zr0 = pnodr(3)
00287 zz0 = pnodz(3)
00288 za11 = pnodr(1) - pnodr(3)
00289 za12 = pnodr(2) - pnodr(3)
00290 za21 = pnodz(1) - pnodz(3)
00291 za22 = pnodz(2) - pnodz(3)
00292 zdet = za11*za22 - za12*za21
00293 zb11 = za22/zdet
00294 zb12 = -za12/zdet
00295 zb21 = -za21/zdet
00296 zb22 = za11/zdet
00297 zx0 = (zz0*za12-zr0*za22)/zdet
00298 ze0 = (zr0*za21-zz0*za11)/zdet
00299 z00e = psiele(3)
00300 zx1e = 4.e00*psiele(5)-3.e00*psiele(3)-psiele(1)
00301 zy1e = 4.e00*psiele(4)-3.e00*psiele(3)-psiele(2)
00302 zx2e = 2.e00*(psiele(1)+psiele(3)-2.e00*psiele(5))
00303 zxye = 4.e00*(psiele(3)+psiele(6)-
00304 + psiele(4)-psiele(5))
00305 zy2e = 2.e00*(psiele(2)+psiele(3)-2.e00*psiele(4))
00306 zp00 = z00e + zx1e*zx0 + zy1e*ze0 + zx2e*zx0*zx0 +
00307 + zxye*zx0*ze0 + zy2e*ze0*ze0
00308 zpr1 = zx1e*zb11 + zy1e*zb21 +
00309 + zxye*(zb11*ze0+zb21*zx0) +
00310 + 2.e00*(zx2e*zb11*zx0+zy2e*zb21*ze0)
00311 zpz1 = zx1e*zb12 + zy1e*zb22 +
00312 + zxye*(zb12*ze0+zb22*zx0) +
00313 + 2.e00*(zx2e*zb12*zx0+zy2e*zb22*ze0)
00314 zpr2 = zx2e*zb11*zb11 +zxye*zb11*zb21 +zy2e*zb21*zb21
00315 zprz = 2.e00*(zx2e*zb11*zb12+zy2e*zb21*zb22) +
00316 + zxye*(zb11*zb22+zb12*zb21)
00317 zpz2 = zx2e*zb12*zb12 +zxye*zb12*zb22 +zy2e*zb22*zb22
00318 psi4(j50,j49) = zp00 + zpr1*xrp(j50) + zpz1*xzp(j49) +
00319 + zpr2*xrp(j50)*xrp(j50) +
00320 + zprz*xrp(j50)*xzp(j49) +
00321 + zpz2*xzp(j49)*xzp(j49)
00322 lcount = lcount + 1
00323 c
00324 if(kwrite.gt.0) then
00325 write(nwrite,2300) j50,j49,j29
00326 +, xrp(j50),xzp(j49),psi4(j50,j49)
00327 write(nwrite,2400)
00328 + pnodr(1),pnodr(2),pnodr(3)
00329 +, pnodz(1),pnodz(2),pnodz(3)
00330 +, psiele(1),psiele(2),psiele(3)
00331 write(nwrite,2500) zarea,zarsum,zardif
00332 endif
00333 c
00334 csi = zx0 + zb11*xrp(j50) + zb12*xzp(j49)
00335 eta = ze0 + zb21*xrp(j50) + zb22*xzp(j49)
00336 go to 49
00337 endif
00338 29 continue
00339 290 continue
00340 49 continue
00341 c
00342 if(kbpol.gt.0) then
00343 yrp = xrp(j50)
00344 yzp = xzp(j49)
00345 CALL [BPOLRZ](pt2dg_8f.html#a6512103c7c194607f9a5868f70673f38)
00346 c -----======
00347 bpr(j50,j49) = ybpolr
00348 bpz(j50,j49) = ybpolz
00349 c--b
00350 cK-cK-cK-cK-cK-cK-cK-cK- if(j49.eq.1) write(nwrite,5000)
00351 cK-cK-cK-cK-cK-cK-cK-cK- write(nwrite,5001) j50,j49,ybpolr,ybpolz
00352 cK- +,cK-cK-cK-cK-cK-cK-cK-cK-cK-cK-cK-cK-cK-cK-cK-yrp,cK-yzp
00353 cK-cK-cK-cK-cK-cK-cK-cK- write(nwrite,5002) lnnk,csi,eta
00354 c--e
00355 endif
00356 c
00357 490 continue
00358 500 continue
00359 c
00360 c
00361 c
00362 if(kwrite.gt.0) then
00363 write(nwrite,3000) (xrp(jr),jr=1,6)
00364 do 600 jz = 1,mpz
00365 write(nwrite,3100) xzp(jz),
00366 + psi4(1,jz),psi4(2,jz),psi4(3,jz),
00367 + psi4(4,jz),psi4(5,jz),psi4(6,jz)
00368 600 continue
00369 write(6,2000) mpr,mpz,lcount
00370 endif
00371 c
00372 c
00373 lwreqdg = nwreqdg
00374 c
00375 CALL WREQDG(lwreqdg,kret,mpr,mpz,psib,
00376 + btf,rtf,xrp,xzp,psi4)
00377 c
00378 write(nwrite,2100) kret
00379 c
00380 c
00381 if(kbpol.gt.0) then
00382 CALL [WBPOLRZ](pt2dg_8f.html#aa8661f7bb97ebf7d6b7eb7389a5bfe41)
00383 c -----=======
00384 endif
00385 c
00386 c
00387 c-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-
00388 c
00389 c +--------------------------------------------+
00390 c | FORMATs to read the mesh data (unit NREAD) |
00391 c +--------------------------------------------+
00392 c
00393 1000 format(3i5)
00394 1001 format(2i5,1p,2e20.8)
00395 1002 format(9i5)
00396 1003 format(80a1)
00397 1060 format(10x,'Stop in AAMAIN :',/
00398 +, 10x,'mnodes = ',i5,' ### nnodes = ',i5,/
00399 +, 10x,'Please set nnodes .gt. mnodes ')
00400 1070 format(10x,'Stop in AAMAIN :',/
00401 +, 10x,'melems = ',i5,' ### nelems = ',i5,/
00402 +, 10x,'Please set nelems .gt. melems ')
00403 1100 format(10x,'Stop in AAMAIN :',/
00404 +, 10x,'label of nodes should be 1',/
00405 +, 10x,'label = ',i2)
00406 c
00407 2000 format(1h1,5(' ',/),20x,'Message from AAMAIN:'
00408 +,3(' ',/),t10,'mpr =',i4,t35,'mpz =',i4,t50,'lcount =',i4)
00409 2100 format(4(' ',/),t15,'After call of WREQDG: kret =',i3)
00410 2200 format(1h1,5(' ',/),t20,'npr =',i4,t40,'npz =',i4
00411 +,/, t20,'mpr =',i4,t40,'mpz =',i4)
00412 2300 format(4(' ',/),t13,'j50 =',i3,t43,'j49 =',i3
00413 +, t91,'inside element No. ',i5
00414 +,/, t10,'xrp(*) =',1p,e12.4,t40,'xzp(*) =',e12.4
00415 +, t67,'psi4(*,*) =',e12.4)
00416 2400 format(' ',/
00417 +, t10,' r(1) =',1p,e12.4,t40,' r(2) =',e12.4
00418 +, t70,' r(3) =',e12.4,/
00419 +, t10,' z(1) =', e12.4,t40,' z(2) =',e12.4
00420 +, t70,' z(3) =',e12.4,/
00421 +, t10,'psi(1) =', e12.4,t40,'psi(2) =',e12.4
00422 +, t70,'psi(3) =',e12.4)
00423 2500 format(t10,' zarea =',1p,e12.4,t40,'zarsum =',e12.4
00424 +, t70,'zardif =',e12.4)
00425 2600 format(t10,'Newton'
00426 +, t40,' csi =',1p,e12.4
00427 +, t70,' eta =',e12.4)
00428 3000 format(1h1,5(' ',/),t18,1p,e16.4,5e16.4)
00429 3100 format( t2 ,1p,e16.4,6e16.4)
00430 c--b
00431 5000 format(' ',/,' ')
00432 5001 format(' ',/
00433 +, 5x,'j50 =',i3,5x,'j49 =',i3
00434 +, 10x,'bpolr =',1p,e12.4,10x,'bpolz =',e12.4
00435 +,/, t39,'yrp =',e12.4,12x,'yzp =',e12.4)
00436 5002 format(4x,'lnnk =',i3,t39,'csi =',e12.4,12x,'eta =',e12.4)
00437 c--e
00438 c
00439 c-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-
00440 c
00441 9999 format(1H1,' ',/)
00442 c
00443 c-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-:-
00444 c
00445 c
00446 END
[00447](pt2dg_8f.html#ab954ece6618d5879ab91cf37b0735a5a) SUBROUTINE [TRINWT](pt2dg_8f.html#ab954ece6618d5879ab91cf37b0735a5a) ! RECTANGLE.AAMAIN
00448 c =================
00449 c
00450 c-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
00451 c
00452 c Decides whether the point yr,yz is inside the curved side
00453 c triangle pnodr(*),pnodz(*).
00454 c
00455 c Input quantities: yr,yz,pnodr(*),pnodz(*).
00456 c Output quantities: kerror, csi,eta.
00457 c
00458 c If the point is inside: kerror=-1, otherwise kerror=+1.
00459 c
00460 c-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
00461 c
00462 #include "eqdim.inc"
00463 #include "pt2dg.inc"
00464 c
00465 c-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
00466 c
00467 c
00468 ztol = 1.e-05
00469 kerror = 1
00470 zr3 = pnodr(3)
00471 zr1c = -pnodr(1) - 3.e00*pnodr(3) + 4.e00*pnodr(5)
00472 zr1e = -pnodr(2) - 3.e00*pnodr(3) + 4.e00*pnodr(4)
00473 zr2c = 2.e00*(pnodr(1)+pnodr(3)) - 4.e00*pnodr(5)
00474 zrce = 4.e00*(pnodr(3)-pnodr(4)-pnodr(5)+pnodr(6))
00475 zr2e = 2.e00*(pnodr(2)+pnodr(3)) - 4.e00*pnodr(4)
00476 zz3 = pnodz(3)
00477 zz1c = -pnodz(1) - 3.e00*pnodz(3) + 4.e00*pnodz(5)
00478 zz1e = -pnodz(2) - 3.e00*pnodz(3) + 4.e00*pnodz(4)
00479 zz2c = 2.e00*(pnodz(1)+pnodz(3)) - 4.e00*pnodz(5)
00480 zzce = 4.e00*(pnodz(3)-pnodz(4)-pnodz(5)+pnodz(6))
00481 zz2e = 2.e00*(pnodz(2)+pnodz(3)) - 4.e00*pnodz(4)
00482 csi = 0.33333e00
00483 eta = 0.33333e00
00484 do 100 j10 = 1,100
00485 zfr = -yrp + zr3 + zr1c*csi + zr1e*eta +
00486 + zr2c*csi*csi + zrce*csi*eta + zr2e*eta*eta
00487 zfz = -yzp + zz3 + zz1c*csi + zz1e*eta +
00488 + zz2c*csi*csi + zzce*csi*eta + zz2e*eta*eta
00489 zdfrc = zr1c + 2.e00*zr2c*csi + zrce*eta
00490 zdfre = zr1e + zrce*csi + 2.e00*zr2e*eta
00491 zdfzc = zz1c + 2.e00*zz2c*csi + zzce*eta
00492 zdfze = zz1e + zzce*csi + 2.e00*zz2e*eta
00493 zdelta = zdfrc*zdfze - zdfre*zdfzc
00494 zdcsi = (zfz*zdfre - zfr*zdfze)/zdelta
00495 zdeta = (zfr*zdfzc - zfz*zdfrc)/zdelta
00496 ztest = sqrt(zdcsi*zdcsi + zdeta*zdeta + 1.e-36)
00497 if(ztest.le.ztol) then
00498 go to 99
00499 endif
00500 csi = csi + zdcsi
00501 eta = eta + zdeta
00502 100 continue
00503 c ++++++
00504 RETURN
00505 c ++++++
00506 99 continue
00507 csieta = csi + eta
00508 if(-1.e-03.le.csi. and.
00509 + csi.le.1.001e00\. and.
00510 + -1.e-03.le.eta. and.
00511 + eta.le.1.001e00\. and.
00512 + -1.e-03.le.csieta. and.
00513 + csieta.le.1.001e00 ) then
00514 zp3 = psiele(3)
00515 zp1c = -psiele(1) - 3.e00*psiele(3) + 4.e00*psiele(5)
00516 zp1e = -psiele(2) - 3.e00*psiele(3) + 4.e00*psiele(4)
00517 zp2c = 2.e00*(psiele(1)+psiele(3)) - 4.e00*psiele(5)
00518 zpce = 4.e00*(psiele(3)-psiele(4)-psiele(5)+psiele(6))
00519 zp2e = 2.e00*(psiele(2)+psiele(3)) - 4.e00*psiele(4)
00520 ypsi = zp3 + zp1c*csi + zp1e*eta +
00521 + zp2c*csi*csi + zpce*csi*eta + zp2e*eta*eta
00522 kerror = -1
00523 endif
00524 c
00525 c-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
00526 c
00527 RETURN
00528 END
[00529](pt2dg_8f.html#a6512103c7c194607f9a5868f70673f38) SUBROUTINE [BPOLRZ](pt2dg_8f.html#a6512103c7c194607f9a5868f70673f38) ! RECTANGLE.AAMAIN
00530 c =================
00531 c
00532 c-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
00533 c
00534 c Computes the two (-R- & -Z-) components of Bpoloidal.
00535 c
00536 c Input quantities: csi,eta,yrp,yzp,pnodr(*),pnodz(*),psiele(*)
00537 c Output quantities: ybpolr, ybpolz
00538 c
00539 c-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
00540 c
00541 #include "eqdim.inc"
00542 #include "pt2dg.inc"
00543 c
00544 dimension zf(6), zd(2,6), zjac(2,2)
00545 c
00546 c-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
00547 c
00548 c
00549 do 100 j1 = 1,6
00550 zf(j1) = 0.e00
00551 zd(1,j1) = 0.e00
00552 zd(2,j1) = 0.e00
00553 100 continue
00554 c
00555 c
00556 zl1 = csi
00557 zl2 = eta
00558 zl3 = 1.e00 - zl1 - zl2
00559 zf(1) = zl1*(2.e00*zl1-1.e00)
00560 zf(2) = zl2*(2.e00*zl2-1.e00)
00561 zf(3) = zl3*(2.e00*zl3-1.e00)
00562 zf(4) = 4.e00*zl2*zl3
00563 zf(5) = 4.e00*zl3*zl1
00564 zf(6) = 4.e00*zl1*zl2
00565 zd(1,1) = 4.e00*zl1 - 1.e00
00566 zd(2,2) = 4.e00*zl2 - 1.e00
00567 zd(1,3) = -(4.e00*zl3 - 1.e00)
00568 zd(2,3) = -(4.e00*zl3 - 1.e00)
00569 zd(1,4) = -4.e00*zl2
00570 zd(2,4) = 4.e00*(zl3 - zl2)
00571 zd(1,5) = 4.e00*(zl3 - zl1)
00572 zd(2,5) = -4.e00*zl1
00573 zd(1,6) = 4.e00*zl2
00574 zd(2,6) = 4.e00*zl1
00575 c
00576 c
00577 zrx1 = 4.e00*pnodr(5)-3.e00*pnodr(3)-pnodr(1)
00578 zrx2 = 2.e00*(pnodr(1)+pnodr(3)-2.e00*pnodr(5))
00579 zrxy = 4.e00*(pnodr(3)+pnodr(6)-
00580 + pnodr(4)-pnodr(5))
00581 zjac(1,1) = zrx1 + 2.e00*zrx2*csi + zrxy*eta
00582 c
00583 zry1 = 4.e00*pnodr(4)-3.e00*pnodr(3)-pnodr(2)
00584 zry2 = 2.e00*(pnodr(2)+pnodr(3)-2.e00*pnodr(4))
00585 zjac(1,2) = zry1 + zrxy*csi + 2.e00*zry2*eta
00586 c
00587 zzx1 = 4.e00*pnodz(5)-3.e00*pnodz(3)-pnodz(1)
00588 zzx2 = 2.e00*(pnodz(1)+pnodz(3)-2.e00*pnodz(5))
00589 zzxy = 4.e00*(pnodz(3)+pnodz(6)-
00590 + pnodz(4)-pnodz(5))
00591 zjac(2,1) = zzx1 + 2.e00*zzx2*csi + zzxy*eta
00592 c
00593 zzy1 = 4.e00*pnodz(4)-3.e00*pnodz(3)-pnodz(2)
00594 zzy2 = 2.e00*(pnodz(2)+pnodz(3)-2.e00*pnodz(4))
00595 zjac(2,2) = zzy1 + zzxy*csi + 2.e00*zzy2*eta
00596 c
00597 zjdet = zjac(1,1)*zjac(2,2) - zjac(2,1)*zjac(1,2)
00598 c
00599 c
00600 zpsir = 0.e00
00601 zpsiz = 0.e00
00602 do 200 j2 = 1,6
00603 zpsir = zpsir + psiele(j2)*
00604 + (zjac(2,1)*zd(1,j2)-zjac(2,2)*zd(2,j2))
00605 zpsiz = zpsiz - psiele(j2)*
00606 + (zjac(1,1)*zd(1,j2)-zjac(1,2)*zd(2,j2))
00607 200 continue
00608 zpsir = zpsir/zjdet
00609 zpsiz = zpsiz/zjdet
00610 c
00611 c
00612 ybpolr = zpsiz/yrp
00613 ybpolz =-zpsir/yrp
00614 c
00615 c
00616 c-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
00617 c
00618 RETURN
00619 END
[00620](pt2dg_8f.html#aa8661f7bb97ebf7d6b7eb7389a5bfe41) SUBROUTINE [WBPOLRZ](pt2dg_8f.html#aa8661f7bb97ebf7d6b7eb7389a5bfe41)
00621 c ==================
00622 c
00623 c-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
00624 c
00625 c Writes the two (-R- & -Z-) components of Bpoloidal.
00626 c
00627 c-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
00628 c
00629 #include "eqdim.inc"
00630 #include "pt2dg.inc"
00631 c
00632 c-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
00633 c
00634 lun = nwreqdg
00635 c
00636 write(lun,*)
00637 write(lun,*) ' ((bpr(j,k),j=1,jm),k=1,km)'
00638 write(lun,8000) ((bpr(j,k),j=1,mpr),k=1,mpz)
00639 c
00640 c
00641 write(lun,*)
00642 write(lun,*) ' ((bpz(j,k),j=1,jm),k=1,km)'
00643 write(lun,8000) ((bpz(j,k),j=1,mpr),k=1,mpz)
00644 c
00645 c
00646 c-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
00647 c
00648 RETURN
00649 c
00650 8000 format(5(3x,e15.8))
00651 c
00652 END
00653
[00656](pt2dg_8f.html#adad65bd08d70995527e77cd5d5a6aba2) subroutine [wreqdg](pt2dg_8f.html#adad65bd08d70995527e77cd5d5a6aba2)(lun,iret,nr,nz,psib,btf,rtf,rgr,zgr,pfm)
00657 c=====================================================
00658 c*** Write the equilibrium data in the dg compatible format.
00659 c***
00660 c*** Input:
00661 c*** lun the logical unit number for the output
00662 c*** ngpr the maximum number of points in R direction
00663 c*** nr the actual number of points in R direction
00664 c*** nz the actual number of points in Z direction
00665 c*** psib the poloidal flux at the separatrix
00666 c*** btf the toroidal magnetic field at the R=rtf
00667 c*** rgr the R values for the grid points
00668 c*** zgr the Z values for the grid points
00669 c*** pfm the values of the poloidal flux
00670 c***
00671 c*** Output:
00672 c*** iret return code (0 means OK)
00673 c=====================================================
00674 c
00675 c version : 23.06.97 17:23
00676 c
00677 implicit none
00678 #include "eqdim.inc"
00679 integer lun, iret, nr, nz
00680 real(kind=R8) :: rgr(ngpr), zgr(ngpz), pfm(ngpr,ngpz),
00681 & btf, rtf, psib
00682 integer i, j
00683 c... toroidal field in tesla, radius in m
00684 c btf, rtf, psib
00685 c
00686 c*** Write the toroidal field and the corresponding radius...
00687 c*** -- now obsolete!
00688 c
00689 c write(3,*,err=99) 'Toroidal field in Tesla, radius in m'
00690 c write(3,*,err=99) btf, rtf
00691 c
00692 c*** ... then the plasma equilibrium ...
00693 c
00694 iret=0
00695 write(lun,*,err=99)
00696 / ' jm := no. of grid points in radial direction;'
00697 write(lun,*,err=99)
00698 / ' km := no. of grid points in vertical direction;'
00699 write(lun,*,err=99)
00700 / ' r := radial coordinates of grid points [m];'
00701 write(lun,*,err=99)
00702 / ' z := vertical coordinates of grid points [m];'
00703 write(lun,*,err=99)
00704 / ' psi := flux per radiant at grid points [Wb/rad];'
00705 write(lun,*,err=99)
00706 / ' psib := psi at plasma boundary [Wb/rad];'
00707 write(lun,*,err=99)
00708 / ' btf := toroidal magnetic field [t];'
00709 write(lun,*,err=99)
00710 / ' rtf := major radius at which btf is specified [m];'
00711 write(lun,*,err=99)
00712 write(lun,*,err=99)
00713 write(lun,*,err=99) ' jm = ', nr,';'
00714 write(lun,*,err=99) ' km = ', nz,';'
00715 write(lun,*,err=99) ' psib = ',psib - psib,' Wb/rad;'
00716 write(lun,*,err=99) ' btf = ',btf,' t;'
00717 write(lun,*,err=99) ' rtf = ',rtf,' m;'
00718 write(lun,*,err=99)
00719 write(lun,*,err=99) ' r(1:jm);'
00720 write(lun,8000) (rgr(i),i=1,nr)
00721 write(lun,*)
00722 write(lun,*,err=99) ' z(1:km);'
00723 write(lun,8000) (zgr(i),i=1,nz)
00724 write(lun,*)
00725 write(lun,*) ' ((psi(j,k)-psib,j=1,jm),k=1,km)'
00726 write(lun,8000) ((pfm(i,j)-psib,i=1,nr),j=1,nz)
00727 8000 format(5(3x,e15.8))
00728 iret=0
00729 return
00730 c-----------------------------------------------------
00731 c
00732 99 print *,'==== wreqdg: error writing the files'
00733 iret=8
00734 c
00735 end
fortan 快速入门
https://blog.csdn.net/xiaorui98/article/details/86600847
http://micro.ustc.edu.cn/Fortran/ZJDing/
https://blog.csdn.net/qq_26973089/article/details/86514084
http://v.fcode.cn/video-module.html