! This program will write a GAF = Generic ADAMO File based on the DDL ! structures in toyMC.ddl. The output GAF will be called toyMC.events. ! Note: I have capitalized the name of ADAMO routines in the program. ! Of course, fortran is case-insensitive so there is no need to do this. program write !===================================================================== ! DECLARATIONS !===================================================================== ! Dear Fortran programmers: ALWAYS disable implicit variable declaration ! at the top of your programs, subroutines, and functions! You will save ! yourself an infinite amount of pain. implicit none ! ALL ADAMO routines require you to include the file partap.inc. ! It contains numerous ADAMO-specific definitions that you will need. #include "partap.inc" ! Now include the window common block (WCB) definitions for all ! the tables you want to use. These include files were all created ! by the makeddl script, using the MAD program. #include "mcEvKey.inc" #include "mcEvent.inc" #include "mcBeam.inc" #include "mcTrack.inc" #include "mcVert.inc" #include "mcHit.inc" #include "dataPuls.inc" #include "dataHodo.inc" #include "dataCalo.inc" ! Finally declare some variables of your own real ebeam, q2min, q2max, nevents parameter (ebeam = 27.5) parameter (q2min = 1.0) parameter (q2max = 20.0) parameter (nevents = 10) integer i, igaf, idfl, iok, ievent integer decay_vertex, idet character*80 cline ! ... real functions are declared just like variables real notrandom !===================================================================== ! INITIALIZE ADAMO !===================================================================== ! This is really easy. The INITAP routine created by MAD initializes ! ADAMO and also calls the CREOBJ routine to set up your personal ! data structures. call INITAP !===================================================================== ! OPEN A NEW GAF FILE !===================================================================== ! We now create our GAF file using the routine CREGAF. cline = 'NAME=toyMC.events,DRIVER=FZ,FILFOR=EXCH' call CREGAF (igaf,mcEvKey,cline,iok) ! Now for some notes. A lot of this is generally useful for many ADAMO ! commands, so I won't need to repeat it again. ! The First Argument: igaf ! ------------------------ ! igaf will come back with the ADAMO id of your file. ! You will use this in all subsequent commands to refer to the GAF. ! ADAMO objects like tables, dataflows, selectors, ... are almost always ! referred to with such identifier numbers, as you will see. ! The Second Argument: mcEvKey ! ---------------------------- ! mcEvKey specifies the Key Table identifier for your GAF. ! Key tables were explained in the DDL file. Note that mcEvKey itself ! is simply the first variable in common block /mcEvKey/. After you ! run CREOBJ to create this and all your other tables, this first ! variable in each WCB is automatically loaded up with the ! table identifier number. ! Let me prove this to you, and at the same time introduce another ! command, GETTDF, which returns the idetifier number of a table or ! dataflow given its name. (I also show various ways of formatting ! output in Fortran). write(6,900) 'TABLE IDENTIFIERS' print *, 'What is the table identifier for mcEvKey?' write (6,'(4x,a,i4)') 'mcEvKey = ', mcEvKey write (6,100) 'gettdf = ', GETTDF('mcEvKey') 100 format(4x,a,i4) ! The Third Argument: cline ! ------------------------- ! The third argument to cregaf is a string, containing a comma-separated ! list of options. The first is the name of the file. The second and ! third sepcify the file format. The format of the gaf is determined by ! the DRIVER you select. The usual ones are RZ, FZ, and IE. Only the IE ! driver produces ASCII output that you can read, the other two produce ! compressed binary output. The usual format choice in HERMES software ! is FZ, with the modifier 'FILFOR=EXCH' (which modifies the way the ! driver behaves). However, the DAD library, which is a homegrown ! HERMES addition to ADAMO, supplies additional drivers. The vast majority ! of HERMES files are actually in DAD format. We will learn about ! that shortly. For now, we use one of the standard ADAMO drivers. ! Just as an illustration, this is what cline would look like if you ! wanted to write your file in IE format instead. ! cline = 'NAME=toyMC.ie,DRIVER=IE' ! The Fourth Argument: iok ! ------------------------ ! iok comes back with a status code. If it is NON-zero, an error occurred. ! A good programmer checks each and every status code, and reponds. ! For example, here we can print out what happened, and stop the program. if (iok.ne.0) stop 'CREGAF failed.' ! You will see iok appear in many later comands. ! I will ignore all error checking after this for brevity. !===================================================================== ! ********** START LOOP OVER EVENTS ********** !===================================================================== do ievent = 1, nevents write(6,'(/20x,a,i3,1x,a)') '<<<<< EVENT NUMBER ', + ievent, '>>>>>' !===================================================================== ! CLEAR ALL YOUR TABLES !===================================================================== ! Introducing CLETAB and COUTAB ! ----------------------------- ! This example shows how CLETAB can be used to clear a single table, ! or an entire dataflow. ! We also introduce the function COUTAB, which counts the number ! of rows in a table. if (ievent.eq.2) then write (6,900) 'CLEARING TABLES 1' write (6,903) 'Before clearing anything, mcEvent has ', + COUTAB(mcEvent), 'rows, mcTrack has ', + COUTAB(mcTrack), 'rows' ! Here we clear one table, mcTrack call CLETAB (mcTrack) write (6,903) 'After clearing only mcTrack, mcEvent has ', + COUTAB(mcEvent), 'rows, mcTrack has ', + COUTAB(mcTrack), 'rows' endif ! Before loading up our event, though, we should clear ALL the tables. ! Fortunately, we grouped our tables into two dataflows, mcEvData ! and mcEvDigits. Let's clear mcEvData, which contains the mcEvent and ! mcTrack tables. idfl = GETTDF ('mcEvData') call CLETAB (idfl) if (ievent.eq.2) then write (6,903) + 'After clearing dataflow mcEvData, mcEvent has', + COUTAB(mcEvent), 'rows, mcTrack has ', + COUTAB(mcTrack), 'rows' endif ! Let's not forget to clear the tables from dataflow mcEvDigits ... ! Note that you can also use the integer function GETTDF directly as ! an argument to CLETAB. call CLETAB (GETTDF('mcEvDigits')) ! Now a warning: If you recall from the ddl file, we created a third ! dataflow called 'mcEvents'. This dataflow simply contained the other ! two. Calling CLETAB on dataflow mcEvents will FAIL !!! ! CLETAB only clears the tables that are located IMMEDIATELY inside ! a dataflow, it will NOT navigate down a tree of dataflows! !===================================================================== ! FILL YOUR TABLES WITH INFORMATION I: mcEvent and mcBeam !===================================================================== ! Let's store some information to table mcEvent. We will spend some ! time with this table, to demonstrate a few things. ! Introducing the WCB ! ------------------- ! First, fill the Window Common Block = WCB with the information for ! one row. The variables of the WCB are just a STORAGE AREA for one ! row's worth of table information. ! ... The ID column of the table always contains the row number you ! ... are working on. mcEvent_ID = 1 ! ... Store some random numbers in the kinematic fields. mcEvent_Nu = notrandom()*ebeam mcEvent_Q2 = q2min + (q2max-q2min)*notrandom() ! ... Remember that the mcEvent table has a link to the mcBeam table. ! ... This is a trivial link, since mcBeam only ever has one row, so ! ... there is only row we could possibly link to. ! ... The link is encoded as an ordinary integer variable in the WCB. ! ... All we need to do is set this variable to the mcBeam row number ! ... we want to link to. mcEvent_mcBeam = 1 ! Introducing INSTAB ! ------------------ ! Now that the mcEvent WCB contains all the information we need for ! this row, it's time to store the row in the table. Just putting information ! in the WCB does NOT change the table, which is stored in ADAMO memory. ! We must explicitly tell ADAMO to load this row to the table, using ! the subroutine INSTAB. ! ... I'll prove it to you: although we've loaded the WCB with information, ! ... ADAMO still has an empty table if (ievent.eq.1) then write(6,900) 'LOADING TABLES' write(6,902) 'Before INSTAB, mcEvent has ', + COUTAB(mcEvent), 'rows' endif ! ... INSTAB loads the WCB information into memory. call INSTAB (mcEvent) ! ... Let's check that the new row was indeed loaded. if (ievent.eq.1) then write(6,902) 'After INSTAB, mcEvent has ', + COUTAB(mcEvent), 'rows' endif ! Introducing DELTAB and REPTAB ! ----------------------------- ! We now demonstrate the use of DELTAB, to delete a table row. if (ievent.eq.1) then ! ... All that DELTAB needs to know is: "which row do I delete?" ! ... It gets this information from the ID column of the WCB. ! ... mcEvent_ID is ALREADY 1, so there's no need to do this, but ! ... just to prove the point. mcEvent_ID = 1 call DELTAB(mcEvent) write(6,902) 'After DELTAB, mcEvent has ', + COUTAB(mcEvent), 'rows' ! ... The information in the WCB is still in place, so let's just ! ... reload the row to the table. call INSTAB (mcEvent) write(6,902) 'After the second INSTAB, mcEvent has ', + COUTAB(mcEvent), 'rows' endif ! Finally, we demonstrate REPTAB, to replace an existing row. if (ievent.eq.1) then call REPTAB (mcEvent) write(6,902) 'After REPTAB, mcEvent still has ', + COUTAB(mcEvent), 'rows' endif ! Loading the beam information to mcBeam is easy. mcBeam_ID = 1 mcBeam_ZVx = notrandom()*40. - 20. mcBeam_Ebe = ebeam call INSTAB (mcBeam) !===================================================================== ! FILL YOUR TABLES WITH INFORMATION II: mcTrack and mcVert !===================================================================== ! Now we move on to mcTrack, a table that will have more than one row. ! For each event, we will generate 4 tracks: the scattered beam positron, ! a K0_s particle, and two charged pions which are the decay products ! of the K0_s. ! In this section, we will also load up mcVert with the start and stop ! positions of each track. ! Introducing NULL variables ! -------------------------- ! As we load up the first track, we demonstrate the use of the intrinsic ! ADAMO variable INULL. INULL is simply an integer parameter whose value ! is set to some large number in the all-important ADAMO include file ! partap.inc. Take a look at partap.inc to see what I mean. ! Anyway, INULL is just a 'secret code' that you can use in any integer ! fields of your WCB to indicate that the information in this field is ! null (i.e. unset, or irrelevant). The first track is the scattered ! beam positron. You recall that mcTrack has a named link called 'Parent', ! which we can use to link tracks corresponding to decay products to ! their parent particle. The scattered beam positron obviously has no ! parent, so we set the Parent link to INULL. mcTrack_ID = 1 mcTrack_iCharge = +1 mcTrack_cName = 'POSI' mcTrack_P = (ebeam - mcEvent_Nu) mcTrack_Parent = INULL ! As you can see in partap.inc, there are two similar 'secret codes' ! called RNULL and CNULL. You use these to set real and character variables ! respectively to null. ! Introducing NEXT ! ---------------- ! We are not quite done with this first row of mcTrack. We have to ! set the start and stop points of the track in mcVert, and link them ! to mcTrack. No problem. Remember, the WCB information has to be ! explicitly loaded to the tables using INSTAB. ! The starting point of the scattered positron track is just the beam vertex. mcVert_ID = 1 mcVert_X = 0. mcVert_Y = 0. mcVert_Z = mcBeam_ZVx mcTrack_startVert = 1 call INSTAB (mcVert) ! For the stop point, we will just generate some random information and ! load it to the SECOND row of mcVert. Now, we KNOW this is going to ! be the second row, so we could explicitly set mcVert_ID = 2. ! But why keep track of row numbers ourselves? We can use instead another ! 'secret code' from partap.inc, which is the variable NEXT. ! When you set the ID column of the table (i.e. the row number) to NEXT, ! INSTAB knows that you want to load the WCB information to the next ! free row in the table. mcVert_ID = NEXT mcVert_X = notrandom()*10. mcVert_Y = notrandom()*10. mcVert_Z = notrandom()*800. if (ievent.eq.1) then write(6,900) 'USING NEXT' write(6,904) 'Before INSTAB, mcVert_ID = ', mcVert_ID, + '(which is NEXT)' endif call INSTAB (mcVert) ! After INSTAB, you can see that ADAMO has conveniently set the ID variable ! of the WCB to the new row number for you. In our case, this is 2. if (ievent.eq.1) then write(6,904) 'After INSTAB, mcVert_ID = ', mcVert_ID, + '(should be 2)' endif ! With this mcVert row number in hand, we can fill the last link of ! mcTrack, and finally store the first track to the table. mcTrack_stopVert = mcVert_ID call INSTAB (mcTrack) ! Introducing PRITAB and PRIROW ! ----------------------------- ! Let's take this opportunity to introduce some useful commands for ! printing the contents of your tables. Let's get ADAMO to display ! on screen the current content of the mcVert table. if (ievent.eq.1) then write(6,900) 'PRINTING FACILITIES' ! The subroutine PRITAB can be used to print all or part of a table. ! Following is the most common invocation of PRITAB. It uses more ! 'secret codes' from partap.inc to print the entire table. These codes ! are ID, MINC, MAXC, and ALLCOL. write(6,901) 'Example 1: PRITAB the whole table' call PRITAB (mcVert,ID,MINC,MAXC,ALLCOL) ! You can also use the third and fourth arguments to PRITAB to specify ! a range of rows to print. For example, let's print out only the second row. write(6,901) 'Example 2: PRITAB the second row' call PRITAB (mcVert,ID,2,2,ALLCOL) ! Alternatively, the subroutine PRIROW can be used to print the second row. ! The last parameter of this subroutine must be set to the secret code VER. ! This specifies 'vertical' printing mode, and as the ADAMO manual says, ! no other modes are supported at present. write(6,901) 'Example 3: use PRIROW to do the same thing' call PRIROW (mcVert,ID,2,VER) endif ! Introducing CLENXT ! ------------------ if (ievent.eq.1) then write(6,900) 'USING CLENXT' ! Before we continue with the remaining tracks, we need to learn something ! more about how NEXT works. An internal 'next row' counter is maintained ! for each table, and is incremented whenever you add a new row to the ! table. But what happens when you delete rows? Unfortunately, the NEXT ! counter is NOT modified when you do this! Let's demonstrate. ! We will delete the second row of mcVert, and then insert it again using ! mcVert_ID = NEXT. As you will see, the second row of the table is left ! blank, and your information gets stored as the THIRD row! Oops ... mcVert_ID = 2 call DELTAB(mcVert) mcVert_ID = NEXT call INSTAB(mcVert) write(6,901) 'We just deleted and resinserted row #2 ...' ! Remember, after callling INSTAB, mcVert_ID is loaded with the new ! row number. This row number is now 3, not 2: write(6,902) 'After INSTAB, mcVert_ID = ', mcVert_ID write(6,902) 'Table mcVert now looks like this:' call PRITAB (mcVert,ID,MINC,MAXC,ALLCOL) ! We need to fix this. First we delete row 3. call DELTAB(mcVert) ! We still want to reinsert our row #2. We COULD explicitly set mcVert_ID = 2, ! and then call INSTAB. But what we really need to do is CLEAR the internal ! next counter after our deletions. CLENXT does this for us. call CLENXT(mcVert) write(6,902) 'We just used CLENXT to reset the next counter' mcVert_ID = NEXT call INSTAB(mcVert) write(6,902) 'After INSTAB, mcVert_ID = ', mcVert_ID write(6,902) 'Table mcVert now looks like this:' call PRITAB (mcVert,ID,MINC,MAXC,ALLCOL) endif ! Introducing INSENT and INSREL ! ----------------------------- ! Next we load up track 2, which will be an unstable K0_s particle. ! This particle also originates from the primary scattering vertex, ! and will decay after about 1 m of flight. mcTrack_ID = NEXT mcTrack_iCharge = 0 mcTrack_cName = 'K0_S' mcTrack_P = mcEvent_Nu * notrandom() mcTrack_Parent = INULL ! ... We have to generate the stop vertex and store it in mcVert. ! ... Let's also store this mcVert row number for future reference, ! ... since we will need it as the start point for the decay pions. mcVert_ID = NEXT mcVert_X = notrandom()*10. mcVert_Y = notrandom()*10. mcVert_Z = notrandom()*100. call INSTAB (mcVert) decay_vertex = mcVert_ID ! ... Finally store the vertex links. This track starts at the primary ! ... vertex, which is already stored as row 1 of mcVert. We just created ! ... the stop vertex. mcTrack_startVert = 1 mcTrack_stopVert = decay_vertex ! OK, now some new ADAMO commands. All information for this track is in ! the WCB, so we could just call INSTAB(mcTrack) like before. ! However, let's illustrate how INSENT works: if (ievent.eq.1) write(6,900) 'INSENT AND INSREL' call INSENT (mcTrack) ! NOW what did we do? INSENT is sort of a subset of INSTAB. Instead ! of loading ALL information to the table, it only loads ESET information. ! In other words, it loads all table entries that are NOT relationships. ! Let's take a look at mcTrack row 2 ... you'll see that although we ! HAVE set the mcTrack_startVert and mcTrack_stopVert links in the WCB, ! they did NOT get loaded up to the table in memory. if (ievent.eq.1) then write(6,901) + 'After INSENT, mcTrack row #2 still has NULL links:' call PRITAB (mcTrack,ID,2,2,ALLCOL) endif ! The subroutine INSREL is the OTHER subset of INTAB. It loads only ! relationships (RSET information). The 3 arguments of INSREL are: ! (arg1) The id of table 1, FROM WHICH the link originates ! (arg2) The link variable from table 1 ! (arg3) The id of table 2, TO WHICH the link points ! These three arguments are not enough to specify which row from table 1 ! is to linked to which row from table 2. INSREL gets that information ! from the ID columns of the table WCB's. ! ... link current mcTrack row to mcVert row 1 via startVert mcVert_ID = 1 call INSREL (mcTrack,mcTrack_startVert,mcVert) ! ... link current mcTrack row to mcVert row 'decay_vertex' via stopVert mcVert_ID = decay_vertex call INSREL (mcTrack,mcTrack_stopVert,mcVert) ! The links are now stored to the table. Let's check. if (ievent.eq.1) then write(6,901) + 'After INSREL, mcTrack row #2 has filled links:' call PRITAB (mcTrack,ID,2,2,ALLCOL) endif ! I won't demonstrate REPENT, REPREL, DELENT, or DELREL. As you can ! guess, they are the ESET and RSET subsets of REPTAB and DELTAB. ! Introducing NULWIN ! ------------------ ! Tracks 3 and 4 are the decay pions from the K0_s. ! Before we generate these tracks, a small demonstration. NULWIN is a useful ! subroutine that clears all the variables in a WCB in one shot. if (ievent.eq.1) then write(6,900) 'USING NULWIN' ! ... before we call NULWIN, the information in the WCB variables is ! ... simply what is left over from the last row you stored write(6,904) + 'Before NULWIN, mcTrack_iCharge = ', mcTrack_iCharge ! ... After NULWIN, all variables are set to INULL, RNULL, or CNULL, ! ... depending on their type call NULWIN (mcTrack) write(6,904) + 'After NULWIN, mcTrack_iCharge = ', mcTrack_iCharge endif ! Anyway, let's store the last two tracks, and make stop vertices for them. do i = 1, 2 mcTrack_ID = NEXT if (i.eq.1) then mcTrack_iCharge = -1 else mcTrack_iCharge = +1 endif mcTrack_cName = 'PION' mcTrack_P = mcEvent_Nu * notrandom() mcTrack_Parent = 2 mcTrack_StartVert = decay_vertex mcVert_ID = NEXT mcVert_X = notrandom()*10. mcVert_Y = notrandom()*10. mcVert_Z = notrandom()*800. call INSTAB (mcVert) mcTrack_StopVert = mcVert_ID call INSTAB (mcTrack) enddo !===================================================================== ! FILL YOUR TABLES WITH INFORMATION III: mcHit !===================================================================== ! In this section, we will store detector hits and digitizations. ! This is just a toy Monte Carlo, so for brevity we will only consider ! the hits produced by track #1, the scattered beam positron. Also, we ! will generate only one hit in each of the following detectors: ! FC, BC, H1, H2, and CALO. As explained in the ddl file, each hit ! is associated with a 'digitization', which is a simulation of the ! detector's response. The digitizations are stored in different tables ! depending on which type of detector was hit. ! So here we go. We loop over the 5 detectors, generating one hit and ! associated digitization per detector. do idet = 1, 5 ! Generate a random position for the hit. ! (This is just a silly toy program, these positions are goofy of course :)) mcHit_ID = NEXT mcHit_X = notrandom()*200. mcHit_Y = notrandom()*200. mcHit_Z = notrandom()*800. ! The mcHit table has a couple links. One of them is to mcTrack. We are only ! generating hits for the first track, so this link just points to row 1. mcHit_mcTrack = 1 ! Generalized relationships ! ------------------------- ! Now let's generate the digitization for this hit. ! The first two hits correspond to the wire chambers FC and BC ! Wire chamber digitizations go to table dataPuls. if (idet.ge.1.and.idet.le.2) then dataPuls_ID = NEXT dataPuls_iWire = int(notrandom()*500)+1 dataPuls_iTDC = int(notrandom()*8192) if (idet.eq.1) then dataPuls_cName = 'FC' else dataPuls_cName = 'BC' endif call INSTAB (dataPuls) ! Now that the digitization is stored to dataPuls, we can complete ! the current row of the mcHit table by linking it to the new digitization. ! mcHit is linked to dataPuls, dataHodo, and dataCalo via a GENERALIZED ! RELATIONSHIP called 'digiTable'. Not only do we have to supply the ! row number to link to, we also have to show which TABLE we are linking to. ! The WCB provides two variables for this: ! ... this character variable gets the NAME of the table to link to mcHit_digiTable = 'dataPuls' ! ... this integer variable gets the row number to link to mcHit_digiTable_ = dataPuls_ID ! The WCB is now complete. Store this row to mcHit. call INSTAB(mcHit) ! Hits 3 and 4 correspond to the hodoscopes H1 and H2. Hodoscope digitizations ! go to table dataHodo. else if (idet.ge.3.and.idet.le.4) then dataHodo_ID = NEXT dataHodo_iWire = int(notrandom()*42) + 1 dataHodo_iTDC = int(notrandom()*8192) dataHodo_iADC = int(notrandom()*8192) if (idet.eq.3) then dataHodo_cName = 'H1' else dataHodo_cName = 'H2' endif call INSTAB (dataHodo) ! Remember INSENT and INSREL? They were subsets of INSTAB, for storing ! only ESET or RSET information. Well, there is one more subset of ! INSTAB, called INSGEN. This is used to store GENERALIZED RELATIONSHIPS. ! Let's illustrate this different manner of storing our new row to mcHit. ! ... store the ESET information call INSENT (mcHit) ! ... store the link to mcTrack, which is a normal relationship mcTrack_ID = 1 call INSREL (mcHit,mcHit_mcTrack,mcTrack) ! ... Store the generalized link to dataHodo. ! ... INSGEN needs the target row number to be stored in dataHodo_ID. ! ... This is already true, since we just loaded up the new row to dataHodo. call INSGEN (mcHit,mcHit_digiTable,dataHodo) ! Finally, hit 5 correspond to the calorimeter. Calo digitizations ! go to table dataCalo. else dataCalo_ID = NEXT dataCalo_iCell = int(notrandom()*840) + 1 dataCalo_rPuls = notrandom()*ebeam dataCalo_cName = 'CALO' call INSTAB (dataCalo) mcHit_digiTable = 'dataCalo' mcHit_digiTable_ = dataCalo_ID call INSTAB (mcHit) endif enddo ! ! Let's prove all this worked by printing out the mcHit table if (ievent.eq.1) then write(6,900) 'GENERALIZED RELATIONSHIPS' call PRITAB (mcHit,ID,MINC,MAXC,ALLCOL) endif !===================================================================== ! STORE THE EVENT RECORD TO THE GAF !===================================================================== ! We have finally loaded all the information for this event to our tables. ! It's time to store this record to the GAF: although the tables are ! now stored in memory, they have not yet been sent to the output file. ! We do this using INSGAF and the key table. Remember, the key table? ! It is a special table which does two things: ! (1) It contains enough information to uniquely identify each record ! (in our case, this is just the event number, and a run number) ! (2) Its last variable cName is used to tell INSGAF which dataflow ! to store to the GAF. We want to load all tables to the GAF, ! so we specify the uber-dataflow mcEvents here. mcEvKey_ID = 1 mcEvKey_iRun = 1 mcEvKey_iEvent = ievent mcEvKey_cName = 'mcEvents' call INSGAF (igaf,mcEvKey,iok) ! Note that we did not have to call INSTAB to store this information ! to the key table. The key table is NOT an ordinary table. Its one ! row of information appears in a special spot at the top of each ! GAF record. It does not get stored as a regular table. !===================================================================== ! ********** END LOOP OVER EVENTS ********** !===================================================================== enddo ! !===================================================================== ! CLOSE THE GAF !===================================================================== call CLOGAF (igaf,iok) 900 format(/,20('='),1x,a,1x,20('=')/) 901 format(3x,a) 902 format(3x,a,i2,1x,a) 903 format(3x,a,i2,1x,a,i2,1x,a) 904 format(3x,a,i3,1x,a) end !===================================================================== ! CODING EXAMPLE: the NOTRANDOM number generator :) !===================================================================== ! A little programming example of a real function that generates completely ! predictable, non-random numbers between 0 and 1. :) ! Note: although this function does not take any arguments, you have to ! CALL it like this: notrandom(). ! Otherwise, the compiler will think notrandom is just a variable. real function notrandom() real increment parameter (increment=0.09) real current_number common /somename/ current_number logical first_call, first_demo data first_call/.true./, first_demo/.true./ save first_call, first_demo real demo ! Initialize. Could have left out first_call and just done ! data current_number/0/ if (first_call) then current_number = 0. first_call = .false. endif current_number = current_number + increment if (current_number.gt.1..and.first_demo) then write(6,900) 'NOTRANDOM coding example' print *, ' These three commands do the same thing' demo = mod(current_number,1) write(6,999) 'Using mod:', demo demo = current_number - int(current_number) write(6,999) 'Using int:', demo if (current_number.gt.1.) demo = current_number-1.0 write(6,999) 'Using if:', demo first_demo = .false. endif current_number = mod(current_number,1) notrandom = current_number return 900 format(/,20('='),1x,a,1x,20('=')/) 999 format(5x,a,t30,f4.2) end