/[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.2 by heimbach, Fri Jul 13 13:40:17 2001 UTC revision 1.3 by heimbach, Mon Aug 13 18:10:26 2001 UTC
# Line 598  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 1099  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.2  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22