/[MITgcm]/MITgcm/pkg/ctrl/ctrl_pack.F
ViewVC logotype

Diff of /MITgcm/pkg/ctrl/ctrl_pack.F

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

revision 1.1 by heimbach, Sun Mar 25 22:33:55 2001 UTC revision 1.3 by heimbach, Mon Aug 13 18:10:26 2001 UTC
# Line 42  c     == global variables == Line 42  c     == global variables ==
42    
43  #include "ctrl.h"  #include "ctrl.h"
44  #include "cost.h"  #include "cost.h"
45    #include "optim.h"
46    
47  c     == routine arguments ==  c     == routine arguments ==
48    
# Line 239  c     --> check cbuffindex. Line 240  c     --> check cbuffindex.
240                            
241  #endif  #endif
242    
243    #ifdef ALLOW_TR10_CONTROL
244    
245              il=ilnblnk( xx_tr1_file)
246              write(fname(1:80),'(80a)') ' '
247              write(fname(1:80),'(2a,i10.10)')
248         &         xx_tr1_file(1:il),'.',optimcycle
249              call MDSREADFIELD_3D_GL( fname,
250         &                          prec, 'RL', Nr, globfld3d,
251         &                          1,  mythid)
252    
253              write(cunit) ncvarindex(9)
254              write(cunit) 1
255              write(cunit) 1
256              do k = 1,nr
257               cbuffindex = 0
258                do jp = 1,nPy
259                 do bj = jtlo,jthi
260                  do j = jmin,jmax
261                   do ip = 1,nPx
262                    do bi = itlo,ithi
263                     do i = imin,imax
264                        if (globmsk(i,bi,ip,j,bj,jp,k)  .ne. 0. ) then
265                           cbuffindex = cbuffindex + 1
266    #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO
267                           cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)
268    cph     &                      * sqrt(wtr1(k,bi,bj))
269    #else
270                           cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)
271    #endif
272                        endif
273                     enddo
274                    enddo
275                   enddo
276                  enddo
277                 enddo
278                enddo
279    c     --> check cbuffindex.
280                if ( cbuffindex .gt. 0) then
281                   write(cunit) cbuffindex
282                   write(cunit) k
283                   write(cunit) (cbuff(ii), ii=1,cbuffindex)
284                endif
285             enddo
286                
287    #endif
288    
289  #ifdef ALLOW_HFLUX0_CONTROL  #ifdef ALLOW_HFLUX0_CONTROL
290    
291            il=ilnblnk( xx_hflux_file)            il=ilnblnk( xx_hflux_file)
# Line 551  c     --> check cbuffindex. Line 598  c     --> check cbuffindex.
598    
599  #endif  #endif
600    
601    #ifdef ALLOW_DIFFKR_CONTROL
602    
603              il=ilnblnk( xx_diffkr_file)
604              write(fname(1:80),'(80a)') ' '
605              write(fname(1:80),'(2a,i10.10)')
606         &         xx_diffkr_file(1:il),'.',optimcycle
607              call MDSREADFIELD_3D_GL( fname,
608         &                          prec, 'RL', Nr, globfld3d,
609         &                          1,  mythid)
610    
611              write(cunit) ncvarindex(15)
612              write(cunit) 1
613              write(cunit) 1
614              do k = 1,nr
615               cbuffindex = 0
616                do jp = 1,nPy
617                 do bj = jtlo,jthi
618                  do j = jmin,jmax
619                   do ip = 1,nPx
620                    do bi = itlo,ithi
621                     do i = imin,imax
622                        if (globmsk(i,bi,ip,j,bj,jp,k)  .ne. 0. ) then
623                           cbuffindex = cbuffindex + 1
624    #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO
625                           cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)
626    cph     &                      * sqrt(wdiffkr(k,bi,bj))
627    #else
628                           cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)
629    #endif
630                        endif
631                     enddo
632                    enddo
633                   enddo
634                  enddo
635                 enddo
636                enddo
637    c     --> check cbuffindex.
638                if ( cbuffindex .gt. 0) then
639                   write(cunit) cbuffindex
640                   write(cunit) k
641                   write(cunit) (cbuff(ii), ii=1,cbuffindex)
642                endif
643             enddo
644                
645    #endif
646    
647    #ifdef ALLOW_KAPGM_CONTROL
648    
649              il=ilnblnk( xx_kapgm_file)
650              write(fname(1:80),'(80a)') ' '
651              write(fname(1:80),'(2a,i10.10)')
652         &         xx_kapgm_file(1:il),'.',optimcycle
653              call MDSREADFIELD_3D_GL( fname,
654         &                          prec, 'RL', Nr, globfld3d,
655         &                          1,  mythid)
656    
657              write(cunit) ncvarindex(16)
658              write(cunit) 1
659              write(cunit) 1
660              do k = 1,nr
661               cbuffindex = 0
662                do jp = 1,nPy
663                 do bj = jtlo,jthi
664                  do j = jmin,jmax
665                   do ip = 1,nPx
666                    do bi = itlo,ithi
667                     do i = imin,imax
668                        if (globmsk(i,bi,ip,j,bj,jp,k)  .ne. 0. ) then
669                           cbuffindex = cbuffindex + 1
670    #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO
671                           cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)
672    cph     &                      * sqrt(wkapgm(k,bi,bj))
673    #else
674                           cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)
675    #endif
676                        endif
677                     enddo
678                    enddo
679                   enddo
680                  enddo
681                 enddo
682                enddo
683    c     --> check cbuffindex.
684                if ( cbuffindex .gt. 0) then
685                   write(cunit) cbuffindex
686                   write(cunit) k
687                   write(cunit) (cbuff(ii), ii=1,cbuffindex)
688                endif
689             enddo
690                
691    #endif
692    
693            close ( cunit )            close ( cunit )
694    
# Line 692  c     --> check cbuffindex. Line 830  c     --> check cbuffindex.
830    
831  #endif  #endif
832    
833    #ifdef ALLOW_TR10_CONTROL
834    
835              il=ilnblnk( xx_tr1_file)
836              write(fname(1:80),'(80a)') ' '
837              write(fname(1:80),'(3a,i10.10)')
838         &         yadmark,xx_tr1_file(1:il),'.',optimcycle
839    
840              call MDSREADFIELD_3D_GL( fname,
841         &                          prec, 'RL', Nr,
842         &                          globfld3d,
843         &                          1,  mythid)
844              
845              write(cunit) ncvarindex(9)
846              write(cunit) 1
847              write(cunit) 1
848              do k = 1,nr
849               cbuffindex = 0
850                do jp = 1,nPy
851                 do bj = jtlo,jthi
852                  do j = jmin,jmax
853                   do ip = 1,nPx
854                    do bi = itlo,ithi
855                     do i = imin,imax
856                        if (globmsk(i,bi,ip,j,bj,jp,k)  .ne. 0. ) then
857                           cbuffindex = cbuffindex + 1
858    #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO
859                           cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)
860    cph     &                      * sqrt(wtr1(k,bi,bj))
861    #else
862                           cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)
863    #endif
864                        endif
865                     enddo
866                    enddo
867                   enddo
868                  enddo
869                 enddo
870                enddo
871    c     --> check cbuffindex.
872                if ( cbuffindex .gt. 0) then
873                   write(cunit) cbuffindex
874                   write(cunit) k
875                   write(cunit) (cbuff(ii), ii=1,cbuffindex)
876                endif
877             enddo
878    
879    #endif
880    
881  #ifdef ALLOW_HFLUX0_CONTROL  #ifdef ALLOW_HFLUX0_CONTROL
882    
# Line 1005  c     --> check cbuffindex. Line 1190  c     --> check cbuffindex.
1190    
1191  #endif  #endif
1192    
1193    #ifdef ALLOW_DIFFKR_CONTROL
1194    
1195              il=ilnblnk( xx_diffkr_file)
1196              write(fname(1:80),'(80a)') ' '
1197              write(fname(1:80),'(3a,i10.10)')
1198         &         yadmark,xx_diffkr_file(1:il),'.',optimcycle
1199    
1200              call MDSREADFIELD_3D_GL( fname,
1201         &                          prec, 'RL', Nr,
1202         &                          globfld3d,
1203         &                          1,  mythid)
1204              
1205              write(cunit) ncvarindex(9)
1206              write(cunit) 1
1207              write(cunit) 1
1208              do k = 1,nr
1209               cbuffindex = 0
1210                do jp = 1,nPy
1211                 do bj = jtlo,jthi
1212                  do j = jmin,jmax
1213                   do ip = 1,nPx
1214                    do bi = itlo,ithi
1215                     do i = imin,imax
1216                        if (globmsk(i,bi,ip,j,bj,jp,k)  .ne. 0. ) then
1217                           cbuffindex = cbuffindex + 1
1218    #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO
1219                           cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)
1220    cph     &                      * sqrt(wdiffkr(k,bi,bj))
1221    #else
1222                           cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)
1223    #endif
1224                        endif
1225                     enddo
1226                    enddo
1227                   enddo
1228                  enddo
1229                 enddo
1230                enddo
1231    c     --> check cbuffindex.
1232                if ( cbuffindex .gt. 0) then
1233                   write(cunit) cbuffindex
1234                   write(cunit) k
1235                   write(cunit) (cbuff(ii), ii=1,cbuffindex)
1236                endif
1237             enddo
1238    
1239    #endif
1240    
1241    #ifdef ALLOW_KAPGM_CONTROL
1242    
1243              il=ilnblnk( xx_kapgm_file)
1244              write(fname(1:80),'(80a)') ' '
1245              write(fname(1:80),'(3a,i10.10)')
1246         &         yadmark,xx_kapgm_file(1:il),'.',optimcycle
1247    
1248              call MDSREADFIELD_3D_GL( fname,
1249         &                          prec, 'RL', Nr,
1250         &                          globfld3d,
1251         &                          1,  mythid)
1252              
1253              write(cunit) ncvarindex(9)
1254              write(cunit) 1
1255              write(cunit) 1
1256              do k = 1,nr
1257               cbuffindex = 0
1258                do jp = 1,nPy
1259                 do bj = jtlo,jthi
1260                  do j = jmin,jmax
1261                   do ip = 1,nPx
1262                    do bi = itlo,ithi
1263                     do i = imin,imax
1264                        if (globmsk(i,bi,ip,j,bj,jp,k)  .ne. 0. ) then
1265                           cbuffindex = cbuffindex + 1
1266    #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO
1267                           cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)
1268    cph     &                      * sqrt(wkapgm(k,bi,bj))
1269    #else
1270                           cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)
1271    #endif
1272                        endif
1273                     enddo
1274                    enddo
1275                   enddo
1276                  enddo
1277                 enddo
1278                enddo
1279    c     --> check cbuffindex.
1280                if ( cbuffindex .gt. 0) then
1281                   write(cunit) cbuffindex
1282                   write(cunit) k
1283                   write(cunit) (cbuff(ii), ii=1,cbuffindex)
1284                endif
1285             enddo
1286    
1287    #endif
1288    
1289    
1290            close ( cunit )            close ( cunit )
1291    
1292        return        return
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22