Examples/calcium2/code1.f

   1 C Copyright (C) 2009-2023  EDF
   2 C
   3 C This library is free software; you can redistribute it and/or
   4 C modify it under the terms of the GNU Lesser General Public
   5 C License as published by the Free Software Foundation; either
   6 C version 2.1 of the License, or (at your option) any later version.
   7 C
   8 C This library is distributed in the hope that it will be useful,
   9 C but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 C MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11 C Lesser General Public License for more details.
  12 C
  13 C You should have received a copy of the GNU Lesser General Public
  14 C License along with this library; if not, write to the Free Software
  15 C Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
  16 C
  17 C See http://www.salome-platform.org/ or email : webmaster.salome@opencascade.com
  18 C
  19
  20        SUBROUTINE SERV1(compo,a,b,c)
  21        include 'calcium.hf'
  22        integer compo(2)
  23        integer i, nval, info, z(10), l
  24        integer*8 lz(10)
  25        integer*4 z4(10),lo(10)
  26
  27        real*8 dd(10),a,b,c,ti,tf,t
  28        real*4 u(20)
  29        real*4 tti,ttf,tt
  30        character*10 s(3)
  31        character*20 rs(3)
  32        character*64 instance
  33
  34        write(6,*)a,b
  35        call cpcd(compo,instance,info)
  36        write(6,*)"instance name=",instance
  37
  38 C  write
  39        tt=0.
  40        t=0.
  41        dd(1)=125.45
  42        dd(2)=8.8
  43        i=1
  44        l=10
  45        CALL cpedb(compo,CP_TEMPS,t,i,'ba',l,dd,info)
  46        t=1.
  47        CALL cpedb(compo,CP_TEMPS,t,i,'ba',l,dd,info)
  48        t=2.
  49        CALL cpedb(compo,CP_TEMPS,t,i,'ba',l,dd,info)
  50        write(6,*)'info=',info
  51        call flush(6)
  52
  53        s(1)="titi"
  54        s(2)="tututu"
  55        s(3)="tatatata"
  56        write(6,*)'s=',s
  57        l=3
  58        CALL cpech(compo,CP_TEMPS,tt,i,'bb',l,s,info)
  59        write(6,*)'info=',info
  60        call flush(6)
  61
  62        z(1)=1
  63        z(2)=8
  64        z(3)=0
  65        write(6,*)'z=',z(1)
  66        write(6,*)'z=',z(2)
  67        write(6,*)'z=',z(3)
  68        l=10
  69        CALL cpeen(compo,CP_TEMPS,tt,i,'bc',l,z,info)
  70        write(6,*)'info=',info
  71        call flush(6)
  72
  73        u(1)=1
  74        u(2)=8
  75        u(3)=4
  76        u(4)=4
  77        u(5)=5
  78        u(6)=5
  79        write(6,*)'u=',u(1)
  80        write(6,*)'u=',u(2)
  81        write(6,*)'u=',u(3)
  82        write(6,*)'u=',u(4)
  83        write(6,*)'u=',u(5)
  84        write(6,*)'u=',u(6)
  85        CALL cpecp(compo,CP_TEMPS,tt,i,'bd',l,u,info)
  86        write(6,*)'info=',info
  87        call flush(6)
  88
  89        u(1)=1.1
  90        u(2)=8.8
  91        u(3)=4.4
  92        write(6,*)'u=',u(1)
  93        write(6,*)'u=',u(2)
  94        write(6,*)'u=',u(3)
  95        CALL cpere(compo,CP_TEMPS,tt,i,'be',l,u,info)
  96        write(6,*)'info=',info
  97        call flush(6)
  98
  99        lo(1)=1
 100        lo(2)=0
 101        lo(3)=1
 102        write(6,*)'lo=',lo(1)
 103        write(6,*)'lo=',lo(2)
 104        write(6,*)'lo=',lo(3)
 105        CALL cpelo(compo,CP_TEMPS,tt,i,'bf',l,lo,info)
 106        write(6,*)'info=',info
 107        call flush(6)
 108
 109        lz(1)=11
 110        lz(2)=22
 111        lz(3)=33
 112        write(6,*)'lz=',lz(1)
 113        write(6,*)'lz=',lz(2)
 114        write(6,*)'lz=',lz(3)
 115        CALL cpeln(compo,CP_TEMPS,tt,i,'bg',l,lz,info)
 116        write(6,*)'info=',info
 117        call flush(6)
 118
 119        z4(1)=1
 120        z4(2)=8
 121        z4(3)=0
 122        write(6,*)'z4=',z4(1)
 123        write(6,*)'z4=',z4(2)
 124        write(6,*)'z4=',z4(3)
 125        CALL cpein(compo,CP_TEMPS,tt,i,'bh',l,z4,info)
 126        write(6,*)'info=',info
 127        call flush(6)
 128
 129        lz(1)=11
 130        lz(2)=22
 131        lz(3)=2**30
 132        lz(3)=2**20*lz(3)
 133        write(6,*)'lz=',lz(1)
 134        write(6,*)'lz=',lz(2)
 135        write(6,*)'lz=',lz(3)
 136        CALL cpelg(compo,CP_TEMPS,tt,i,'bi',l,lz,info)
 137        write(6,*)'info=',info
 138        call flush(6)
 139
 140 C  read
 141        ti=0.
 142        tf=1.
 143        i=1
 144        dd(1)=0.
 145        dd(2)=0.
 146        dd(3)=0.
 147        l=3
 148        CALL cpldb(compo,CP_TEMPS,ti,tf,i,'aa',l,nval,dd,info)
 149        write(6,*)'info=',info
 150        write(6,*)'dd=',dd(1)
 151        write(6,*)'dd=',dd(2)
 152        write(6,*)'dd=',dd(3)
 153        write(6,*)'nval=',nval
 154        call flush(6)
 155
 156        tti=0.
 157        ttf=1.
 158        i=1
 159        CALL cplch(compo,CP_TEMPS,tti,ttf,i,'ab',l,nval,rs,info)
 160        write(6,*)'info=',info
 161        write(6,*)'rs=',rs
 162        write(6,*)'nval=',nval
 163        call flush(6)
 164
 165        z(1)=0
 166        z(2)=0
 167        z(3)=0
 168        CALL cplen(compo,CP_TEMPS,tti,ttf,i,'ac',l,nval,z,info)
 169        write(6,*)'info=',info
 170        write(6,*)'nval=',nval
 171        write(6,*)'z=',z(1)
 172        write(6,*)'z=',z(2)
 173        write(6,*)'z=',z(3)
 174        call flush(6)
 175
 176        u(1)=0
 177        u(2)=0
 178        u(3)=0
 179        u(4)=0
 180        u(5)=0
 181        u(6)=0
 182        CALL cplcp(compo,CP_TEMPS,tti,ttf,i,'ad',l,nval,u,info)
 183        write(6,*)'info=',info
 184        write(6,*)'nval=',nval
 185        write(6,*)'u=',u(1)
 186        write(6,*)'u=',u(2)
 187        write(6,*)'u=',u(3)
 188        write(6,*)'u=',u(4)
 189        write(6,*)'u=',u(5)
 190        write(6,*)'u=',u(6)
 191        call flush(6)
 192
 193        u(1)=0
 194        u(2)=0
 195        u(3)=0
 196        CALL cplre(compo,CP_TEMPS,tti,ttf,i,'ae',l,nval,u,info)
 197        write(6,*)'info=',info
 198        write(6,*)'nval=',nval
 199        write(6,*)'u=',u(1)
 200        write(6,*)'u=',u(2)
 201        write(6,*)'u=',u(3)
 202        call flush(6)
 203
 204        lo(1)=0
 205        lo(2)=0
 206        lo(3)=0
 207        CALL cpllo(compo,CP_TEMPS,tti,ttf,i,'af',l,nval,lo,info)
 208        write(6,*)'info=',info
 209        write(6,*)'nval=',nval
 210        write(6,*)'lo=',lo(1)
 211        write(6,*)'lo=',lo(2)
 212        write(6,*)'lo=',lo(3)
 213        call flush(6)
 214
 215        lz(1)=0
 216        lz(2)=0
 217        lz(3)=0
 218        CALL cplln(compo,CP_TEMPS,tti,ttf,i,'ag',l,nval,lz,info)
 219        write(6,*)'info=',info
 220        write(6,*)'nval=',nval
 221        write(6,*)'lz=',lz(1)
 222        write(6,*)'lz=',lz(2)
 223        write(6,*)'lz=',lz(3)
 224        call flush(6)
 225
 226        z4(1)=0
 227        z4(2)=0
 228        z4(3)=0
 229        CALL cplin(compo,CP_TEMPS,tti,ttf,i,'ah',l,nval,z4,info)
 230        write(6,*)'info=',info
 231        write(6,*)'nval=',nval
 232        write(6,*)'z4=',z4(1)
 233        write(6,*)'z4=',z4(2)
 234        write(6,*)'z4=',z4(3)
 235        call flush(6)
 236
 237        lz(1)=0
 238        lz(2)=0
 239        lz(3)=0
 240        CALL cpllg(compo,CP_TEMPS,tti,ttf,i,'ai',l,nval,lz,info)
 241        write(6,*)'info=',info
 242        write(6,*)'nval=',nval
 243        write(6,*)'lz=',lz(1)
 244        write(6,*)'lz=',lz(2)
 245        write(6,*)'lz=',lz(3)
 246        call flush(6)
 247
 248        call cpfint(compo,'aa',0.5,info)
 249        write(6,*)'info=',info
 250        call flush(6)
 251
 252        ti=0.
 253        tf=0.
 254        l=3
 255        CALL cpldb(compo,CP_TEMPS,ti,tf,i,'aa',l,nval,dd,info)
 256        write(6,*)'info=',info
 257        call flush(6)
 258
 259        call cpefft(compo,'aa',1.5,info)
 260        write(6,*)'info=',info
 261        call flush(6)
 262
 263        ti=2.
 264        tf=2.
 265        l=3
 266        CALL cpldb(compo,CP_TEMPS,ti,tf,i,'aa',l,nval,dd,info)
 267        write(6,*)'info=',info
 268        call flush(6)
 269
 270        c=a+b
 271        return
 272        end