/[MITgcm]/MITgcm/pkg/ecco/cost_geoid.F
ViewVC logotype

Diff of /MITgcm/pkg/ecco/cost_geoid.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.3 by heimbach, Thu Feb 17 20:10:55 2005 UTC revision 1.4 by heimbach, Thu May 5 23:47:57 2005 UTC
# Line 17  c Line 17  c
17  c     started: Christian Eckert eckert@mit.edu 30-Jun-1999  c     started: Christian Eckert eckert@mit.edu 30-Jun-1999
18  c  c
19  c     changed: Christian Eckert eckert@mit.edu 25-Feb-2000  c     changed: Christian Eckert eckert@mit.edu 25-Feb-2000
 c  
20  c              - Restructured the code in order to create a package  c              - Restructured the code in order to create a package
21  c                for the MITgcmUV.  c                for the MITgcmUV.
22  c  c
23  c     changed: Ralf Giering Ralf.Giering@FastOpt.de 12-Jun-2001  c     changed: Ralf Giering Ralf.Giering@FastOpt.de 12-Jun-2001
 c  
24  c              - totally rewrite for parallel processing  c              - totally rewrite for parallel processing
25  c  c
26    c              heimbach@mit.edu 05-May-2005
27    c              - debugged and restructuted
28    c
29  c     ==================================================================  c     ==================================================================
30  c     SUBROUTINE cost_geoid  c     SUBROUTINE cost_geoid
31  c     ==================================================================  c     ==================================================================
# Line 38  c     == global variables == Line 39  c     == global variables ==
39  #include "PARAMS.h"  #include "PARAMS.h"
40    
41  #include "ecco_cost.h"  #include "ecco_cost.h"
42  #include "cost_sph.h"  #ifdef ALLOW_SPHERE
43    # include "sphere.h"
44    #else
45          integer ncShc
46          parameter (ncShc=1)
47    #endif
48    
49  c     == routine arguments ==  c     == routine arguments ==
50    
# Line 54  c     == local variables == Line 60  c     == local variables ==
60    
61        integer i,j        integer i,j
62        integer ilo,ihi        integer ilo,ihi
       integer ilnblnk  
       integer ifnblnk  
63        integer ireads        integer ireads
       integer egmunit  
64        integer egmsize        integer egmsize
65        parameter( egmsize = 8 )        parameter( egmsize = 8 )
66    
67        integer jsize, joff, jbeg, jend, j        integer jsize, joff, jbeg, jend
68          integer reclength
69    
70        _RL factor        _RL factor
71        _RL recip_rr        _RL recip_rr
72    
 c     == external functions ==  
       integer  ilnblnk  
       external ilnblnk  
       integer  ifnblnk  
       external ifnblnk  
   
73  c     == end of interface ==  c     == end of interface ==
74    
75  c--   Only the master thread is doing I/O  c--   Only the master thread is doing I/O
# Line 87  c--   to allow usage of global_sum_r8 Line 85  c--   to allow usage of global_sum_r8
85  c--   Initialise variables.  c--   Initialise variables.
86        recip_rr = recip_rsphere*recip_rsphere        recip_rr = recip_rsphere*recip_rsphere
87    
 c--   Open the geoid error covariance data file.  
       call mdsfindunit( egmunit, mythid )  
       ilo = ifnblnk(geoid_covariancefile)  
       ihi = ilnblnk(geoid_covariancefile)  
   
       print*  
       print*,' cost_Geoid: egmunit              = ',egmunit  
       print*,'             geoid_covariancefile = ',  
      &                     geoid_covariancefile(ilo:ihi)  
       print*,'             opening file ...'  
   
       open(egmunit, file   = geoid_covariancefile(ilo:ihi),  
      &              form   = 'unformatted',  
      &              access = 'direct',  
      &              recl   = ncshc*egmsize,  
      &              status = 'old' )  
   
88  c--   round up the quotient to get jsize  c--   round up the quotient to get jsize
89        jsize = ncshc / numberOfProcs        jsize = ncshc / numberOfProcs
90        if (jsize*numberOfProcs .lt. ncshc ) then        if (jsize*numberOfProcs .lt. ncshc ) then
# Line 114  c--   compute sub-intervall of 1..ncshc Line 95  c--   compute sub-intervall of 1..ncshc
95        joff = myProcId*jsize        joff = myProcId*jsize
96        jbeg = 1 + joff        jbeg = 1 + joff
97        jend = min( ncshc, joff+jsize )        jend = min( ncshc, joff+jsize )
98          reclength = ncshc*egmsize
99    
100  c--   read part of geoid error covariance matrix  c--   read part of geoid error covariance matrix
101  c--   and compute corresponding part of cost contribution  c--   and compute corresponding part of cost contribution
102  CADJ loop = parallel  CADJ loop = parallel
103        do j = jbeg,jend        do j = jbeg,jend
104    
105           read(egmunit,rec=j) pinv           call cost_readgeoid(
106         I       geoid_covariancefile, reclength, j,
107         O       pinv,
108         I       mythid )
109    
110           factor = 0.           factor = 0.
111           do i = 1,ncShc           do i = 1,ncShc
# Line 129  CADJ loop = parallel Line 114  CADJ loop = parallel
114           sphcost = sphcost + factor*shc(j)           sphcost = sphcost + factor*shc(j)
115        enddo        enddo
116    
 c--   close geoid error covariance file  
       close(egmunit)  
   
117        _END_MASTER( mythid )        _END_MASTER( mythid )
118    
119        call global_sum_r8( sphcost, mythid )        call global_sum_r8( sphcost, mythid )
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22